      ***************************************************************
       IDENTIFICATION DIVISION.
      ***************************************************************
       PROGRAM-ID.    P108MT07.
       AUTHOR.        MARCOM PROJECT TEAM.
       DATE-WRITTEN.  NOVEMBER 1992.
      ***************************************************************
      *                                                             *
      *   PROGRAM:  P108MT07 - FORECAST ADD                         *
      *                                                             *
      *   SYSTEM:   MTS - MARCOM TRACKING AND FORECASTING SYSTEM    *
      *                                                             *
      *   FUNCTION: FORECAST ADD                                    *
      *                                                             *
      *   LANGUAGE: COBOL II / SQL / CICS                           *
      *                                                             *
      *   ENTRY:    CICS TRANSACTION ID "MTS7" THRU "MTS0"          *
      *                                                             *
      ***************************************************************
      *                                                             *
      *   DATABASE TABLES AND FILES:                                *
      *                                                             *
      ***************************************************************
      *                                                             *
      *   CALLED SUBROUTINES:                                       *
      *                                                             *
      ***************************************************************
      *                                                             *
      *   MODIFICATIONS:                                            *
      *                                                             *
      *   DATE      PROGRAMMER     DESCRIPTION                      *
      *   --------  -------------  -------------------------------  *
      *   11/01/92                 ORIGINAL VERSION.                *
      *   11/30/92  TRAC VU        EXPAND FROM SKELETON.            *
      *   10/02/94  ABLMSC         CHANGE TO NEW FORECAST SCENARIOS *
      ***************************************************************

       ENVIRONMENT DIVISION.

           EJECT
       DATA DIVISION.

       WORKING-STORAGE SECTION.

       01  FILLER                      PIC X(35) VALUE
           'WORKING STORAGE BEGINS HERE ======>'.
      ***************************************************************
      *                                                             *
      *    PROGRAM CONSTANTS AND WORK FIELDS                        *
      *                                                             *
      ***************************************************************
       01  W0000-PROGRAM-INFO.
           05  PROGRAM-NAME            PIC X(08) VALUE 'P108MT07'.
           05  MAP-NAME                PIC X(08) VALUE 'M108M07'.
           05  SET-NAME                PIC X(08) VALUE 'M108M07'.
           05  TXN-ID                  PIC X(04) VALUE 'MTS7'.
           05  ERROR-FLAG              PIC X(01) VALUE 'N'.
               88   NO-ERRORS      VALUE 'N'.
               88   ERRORS         VALUE 'Y'.
           05  HELP-ERROR-FLAG              PIC X(01) VALUE 'N'.
               88   HELP-NO-ERRORS    VALUE 'N'.
               88   HELP-ERRORS       VALUE 'Y'.
           05  INPUT-FLDS              PIC X(01) VALUE 'N'.
               88   INPUT-FLDS-NOCHG      VALUE 'N'.
               88   INPUT-FLDS-CHANGED    VALUE 'Y'.
           05  FCST-ID-NEW-OLD         PIC X(01) VALUE 'O'.
               88   OLD-FCST-ID           VALUE 'O'.
               88   NEW-FCST-ID           VALUE 'N'.
           05  MAP-TEMP-AREA.
               10  WS-T-UID-CI                 PIC  X(8).
               10  WS-T-FCSID-NI               PIC  X(5).
               10  WS-T-FCSID-XI               PIC  X(020).
               10  WS-T-MKTCBU-CI              PIC  X(003).
               10  WS-T-MKTCDIV-CI             PIC  X(002).
               10  WS-T-MKTCRGN-CI             PIC  X(002).
               10  WS-T-DPT-CI                 PIC  X(004).
               10  WS-T-SUBDPT-CI              PIC  X(003).
               10  WS-T-EXPTYP-CI              PIC  X(002).
               10  WS-T-EXPSUBTYP-CI           PIC  X(003).
               10  WS-T-MGRNM-XI               PIC  X(025).
               10  WS-T-BADGE-CI               PIC  X(006).
               10  WS-T-MGRUID-CI              PIC  X(010).
               10  WS-T-FCS-TABLE   OCCURS  11 TIMES.
                  15  WS-T-FCSP-AI     PIC  X(6).
           05  WS-TIME-BUCKETS    PIC   9(3)   VALUE 11.
           05  WS-WINDOW-SIZE     PIC   9(3)   VALUE 20.

           EJECT
       01  W0001-MISCELLANEOUS-FIELDS.
           05  W0001-PGM-XCTL-NO       PIC  X(08)  VALUE SPACES.
           05  W0001-TXN-ID            PIC  X(04)  VALUE SPACES.
           05  W0001-XCTL-PGM-ID       PIC  X(08)  VALUE 'P108MT01'.
           05  W0001-LINK-PGM-ID       PIC  X(08)  VALUE 'P108MT01'.
           05  W0001-LINK-CA           PIC  X(999) VALUE ALL '#'.
           05  W0001-CURSOR-POS        PIC  S9(4)   COMP-3.
           05  W0001-LINE-NO           PIC  S9(2)   COMP-3.
           05  W0001-LINE-VALUE        PIC  S9(2)   COMP-3 VALUE +80.
           05  W0001-LINE-INDEX        PIC  S9(2)   COMP-3 VALUE +1.
           05  W0001-LINE-BASE         PIC  S9(2)   COMP-3 VALUE -2.
           05  W0001-PRODLN-LINE       PIC  S9(2)   COMP-3 VALUE +8.
           05  W0001-EXPTYP-LINE       PIC  S9(2)   COMP-3 VALUE +9.
           05  W0001-EXPSUBTYP-LINE    PIC  S9(2)   COMP-3 VALUE +9.

           05  W0001-FCST-ID           PIC  9(5) VALUE ZERO.
           05  W0001-RIGHT             PIC  X(5) VALUE SPACES.
           05  W0001-LEFT              PIC  X(5) VALUE SPACES.
           05  W0001-COUNTER           PIC 9(9)  VALUE ZERO.
           05  W0001-COUNTR            PIC S9(05)  USAGE  COMP-3.

           05  W0001-SELECTION-SW      PIC X.
               88  W0001-SELECT-ONE    VALUE 'Y'.
               88  W0001-NO-SELECTION  VALUE 'N'.

           05  W0001-STD-AI      PIC  S9999V9  VALUE ZEROS COMP-3.
           05  W0001-YTD-AI      PIC  S9999V9  VALUE ZEROS COMP-3.
           05  W0001-ATD-AI      PIC  S9999V9  VALUE ZEROS COMP-3.
           05  W0001-PATOT-AI    PIC  S9999V9  VALUE ZEROS COMP-3.
           05  W0001-STD-AI-D    PIC  ------9.
           05  W0001-YTD-AI-D    PIC  ------9.
           05  W0001-ATD-AI-D    PIC  ------9.
           05  W0001-PATOT-AI-D  PIC  ------9.

           05  W0001-FCSP-AREA.
              10  W0001-FCSP-TABLE  OCCURS   11 TIMES.
                  15 W0001-FCSP-AI   PIC  S9999V9  VALUE ZEROS COMP-3.
           05  W0001-FCSP-AI-D51          PIC ------9 .
           05  W0001-FCSP-AI-D41X   REDEFINES  W0001-FCSP-AI-D51.
               10  FILLER            PIC  X.
               10  W0001-FCSP-AI-D41    PIC  -----9 .

           05  I                       PIC  9(9)  USAGE BINARY.
           05  K                       PIC  9(5)  COMP.
           05  W0001-HOLD1             PIC  S999999999V9  COMP-3.
           05  W0001-HOLD2             PIC  S999999999V9  COMP-3.
           05  W0001-HOLD3             PIC  S999999999V9  COMP-3.
           05  W0001-HOLD4             PIC  S999999999V9  COMP-3.
           05  W0001-HOLD5             PIC  S999999999V9  COMP-3.

           05  W0001-KEY1              PIC  X(12).
           05  W0001-KEY1-RD           REDEFINES
               W0001-KEY1.
               10  W0001-K1-F-DPT-C    PIC  X(04).
               10  W0001-K1-F-SUBDPT-C PIC  X(03).
               10  W0001-K1-F-EXPTYP-C PIC  X(02).
               10  W0001-K1-F-SUBTYP-C PIC  X(03).

           05  W0001-KEY2              PIC  X(12).
           05  W0001-KEY2-RD           REDEFINES
               W0001-KEY2.
               10  W0001-K2-F-DPT-C    PIC  X(04).
               10  W0001-K2-F-SUBDPT-C PIC  X(03).
               10  W0001-K2-F-EXPTYP-C PIC  X(02).
               10  W0001-K2-F-SUBTYP-C PIC  X(03).

           05  W0001-KEY3              PIC  X(12).
           05  W0001-KEY3-RD           REDEFINES
               W0001-KEY3.
               10  W0001-K3-F-DPT-C    PIC  X(04).
               10  W0001-K3-F-SUBDPT-C PIC  X(03).
               10  W0001-K3-F-EXPTYP-C PIC  X(02).
               10  W0001-K3-F-SUBTYP-C PIC  X(03).

           05  W0001-KEY4              PIC  X(12).
           05  W0001-KEY4-RD           REDEFINES
               W0001-KEY4.
               10  W0001-K4-F-DPT-C    PIC  X(04).
               10  W0001-K4-F-SUBDPT-C PIC  X(03).
               10  W0001-K4-F-EXPTYP-C PIC  X(02).
               10  W0001-K4-F-SUBTYP-C PIC  X(03).

           05  W0001-KEY5              PIC  X(12).
           05  W0001-KEY5-RD           REDEFINES
               W0001-KEY5.
               10  W0001-K5-F-DPT-C    PIC  X(04).
               10  W0001-K5-F-SUBDPT-C PIC  X(03).
               10  W0001-K5-F-EXPTYP-C PIC  X(02).
               10  W0001-K5-F-SUBTYP-C PIC  X(03).

           05  W0001-KEY6              PIC  X(12).
           05  W0001-KEY6-RD           REDEFINES
               W0001-KEY6.
               10  W0001-K6-F-DPT-C    PIC  X(04).
               10  W0001-K6-F-SUBDPT-C PIC  X(03).
               10  W0001-K6-F-EXPTYP-C PIC  X(02).
               10  W0001-K6-F-SUBTYP-C PIC  X(03).

           05  W0001-K7-F-MKTCRGN-C PIC  X(02).
           05  W0001-K7-F-FCSID-C   PIC  9(05).
           05  W0001-K7-F-FCSID-N   REDEFINES
               W0001-K7-F-FCSID-C   PIC  X(05).


       01  W0001-TOTAL-AMOUNTS.
           05  W0001-Q1A               PIC  S9999V9 VALUE ZEROS.
           05  W0001-Q2A               PIC  S9999V9 VALUE ZEROS.
           05  W0001-Q3A               PIC  S9999V9 VALUE ZEROS.
           05  W0001-Q4A               PIC  S9999V9 VALUE ZEROS.
           05  W0001-H01A              PIC  S9999V9 VALUE ZEROS.
           05  W0001-H02A              PIC  S9999V9 VALUE ZEROS.
           05  W0001-YRA               PIC  S9999V9 VALUE ZEROS.
           05  W0001-YRXA              PIC  S9999V9 VALUE ZEROS.
           05  W0001-Q1XA              PIC  S9999V9 VALUE ZEROS.
           05  W0001-Q2XA              PIC  S9999V9 VALUE ZEROS.
           05  W0001-Q3XA              PIC  S9999V9 VALUE ZEROS.
           05  W0001-Q4XA              PIC  S9999V9 VALUE ZEROS.
           05  W0001-H1XA              PIC  S9999V9 VALUE ZEROS.
           05  W0001-H2XA              PIC  S9999V9 VALUE ZEROS.

           05  W0001-ABSTIME           PIC S9(16)  COMP.
           05  W0001-HHCMMCSS.
               10  W0001-HR            PIC  X(02).
               10  W0001-C1            PIC  X(01).
               10  W0001-MIN           PIC  X(02).
               10  W0001-C2            PIC  X(01).
               10  W0001-SEC           PIC  X(02).
           05  W0001-MMSDDSYY.
               10  W0001-MON           PIC  X(02).
               10  W0001-S1            PIC  X(01).
               10  W0001-DAY           PIC  X(02).
               10  W0001-S1            PIC  X(01).
               10  W0001-YEAR          PIC  X(02).
           05  W0001-YYYY.
               10  W0001-YY            PIC  X(04).

           05  W0001-FISCAL-PERIOD.
               10  W0001-FISCAL-CC       PIC  X(02)  VALUE SPACES.
               10  W0001-FISCAL-YY       PIC  X(02)  VALUE SPACES.
               10  W0001-FISCAL-MM       PIC  X(02)  VALUE SPACES.

           05  W0001-FYPD.
               10  W0001-FYPD-YY         PIC  X(02)  VALUE SPACES.
               10  W0001-FYPD-MM         PIC  X(02)  VALUE SPACES.


           EJECT
       01  W0001-HEADING-SCENARIOS.
           05  W0002-HDG.
               10  W0002-HDG-01       PIC X(05) VALUE SPACES.
               10  W0002-HDG-02       PIC X(05) VALUE SPACES.
               10  W0002-HDG-03       PIC X(05) VALUE SPACES.
               10  W0002-HDG-04       PIC X(05) VALUE SPACES.
               10  W0002-HDG-05       PIC X(05) VALUE SPACES.
               10  W0002-HDG-06       PIC X(05) VALUE SPACES.
               10  W0002-HDG-07       PIC X(05) VALUE SPACES.
               10  W0002-HDG-08       PIC X(05) VALUE SPACES.
               10  W0002-HDG-09       PIC X(05) VALUE SPACES.
               10  W0002-HDG-10       PIC X(05) VALUE SPACES.
               10  W0002-HDG-11       PIC X(05) VALUE SPACES.

           05  W0002-HDG1-PD01.
               10  W0002-HDG1-PD01-01  PIC X(05) VALUE '  P1 '.
               10  W0002-HDG1-PD01-02  PIC X(05) VALUE '  P1 '.
               10  W0002-HDG1-PD01-03  PIC X(05) VALUE '  P2 '.
               10  W0002-HDG1-PD01-04  PIC X(05) VALUE '  P3 '.
               10  W0002-HDG1-PD01-05  PIC X(05) VALUE '  Q1 '.
               10  W0002-HDG1-PD01-06  PIC X(05) VALUE '  Q2 '.
               10  W0002-HDG1-PD01-07  PIC X(05) VALUE '  Q3 '.
               10  W0002-HDG1-PD01-08  PIC X(05) VALUE '  Q4 '.
               10  W0002-HDG1-PD01-09  PIC X(05) VALUE '  FY '.
               10  W0002-HDG1-PD01-10  PIC X(05) VALUE '     '.
               10  W0002-HDG1-PD01-11  PIC X(05) VALUE '     '.

           05  W0002-HDG2-PD01.
               10  W0002-HDG2-PD01-01  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD01-02  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD01-03  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD01-04  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD01-05  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD01-06  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD01-07  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD01-08  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD01-09  PIC X(05) VALUE 'TOTAL'.
               10  W0002-HDG2-PD01-10  PIC X(05) VALUE '     '.
               10  W0002-HDG2-PD01-11  PIC X(05) VALUE '     '.


           05  W0002-HDG1-PD02.
               10  W0002-HDG1-PD02-01  PIC X(05) VALUE '  P1 '.
               10  W0002-HDG1-PD02-02  PIC X(05) VALUE '  P2 '.
               10  W0002-HDG1-PD02-03  PIC X(05) VALUE '  P2 '.
               10  W0002-HDG1-PD02-04  PIC X(05) VALUE '  P3 '.
               10  W0002-HDG1-PD02-05  PIC X(05) VALUE '  Q1 '.
               10  W0002-HDG1-PD02-06  PIC X(05) VALUE '  Q2 '.
               10  W0002-HDG1-PD02-07  PIC X(05) VALUE '  Q3 '.
               10  W0002-HDG1-PD02-08  PIC X(05) VALUE '  Q4 '.
               10  W0002-HDG1-PD02-09  PIC X(05) VALUE '  FY '.
               10  W0002-HDG1-PD02-10  PIC X(05) VALUE '     '.
               10  W0002-HDG1-PD02-11  PIC X(05) VALUE '     '.

           05  W0002-HDG2-PD02.
               10  W0002-HDG2-PD02-01  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD02-02  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD02-03  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD02-04  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD02-05  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD02-06  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD02-07  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD02-08  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD02-09  PIC X(05) VALUE 'TOTAL'.
               10  W0002-HDG2-PD02-10  PIC X(05) VALUE '     '.
               10  W0002-HDG2-PD02-11  PIC X(05) VALUE '     '.


           05  W0002-HDG1-PD03.
               10  W0002-HDG1-PD03-01  PIC X(05) VALUE '  P1 '.
               10  W0002-HDG1-PD03-02  PIC X(05) VALUE '  P2 '.
               10  W0002-HDG1-PD03-03  PIC X(05) VALUE '  P3 '.
               10  W0002-HDG1-PD03-04  PIC X(05) VALUE '  P3 '.
               10  W0002-HDG1-PD03-05  PIC X(05) VALUE '  Q1 '.
               10  W0002-HDG1-PD03-06  PIC X(05) VALUE '  P4 '.
               10  W0002-HDG1-PD03-07  PIC X(05) VALUE '  P5 '.
               10  W0002-HDG1-PD03-08  PIC X(05) VALUE '  P6 '.
               10  W0002-HDG1-PD03-09  PIC X(05) VALUE '  Q3 '.
               10  W0002-HDG1-PD03-10  PIC X(05) VALUE '  Q4 '.
               10  W0002-HDG1-PD03-11  PIC X(05) VALUE '  FY '.

           05  W0002-HDG2-PD03.
               10  W0002-HDG2-PD03-01  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD03-02  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD03-03  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD03-04  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD03-05  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD03-06  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD03-07  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD03-08  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD03-09  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD03-10  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD03-11  PIC X(05) VALUE 'TOTAL'.


           05  W0002-HDG1-PD04.
               10  W0002-HDG1-PD04-01  PIC X(05) VALUE '  Q1 '.
               10  W0002-HDG1-PD04-02  PIC X(05) VALUE '  P4 '.
               10  W0002-HDG1-PD04-03  PIC X(05) VALUE '  P4 '.
               10  W0002-HDG1-PD04-04  PIC X(05) VALUE '  P5 '.
               10  W0002-HDG1-PD04-05  PIC X(05) VALUE '  P6 '.
               10  W0002-HDG1-PD04-06  PIC X(05) VALUE '  Q2 '.
               10  W0002-HDG1-PD04-07  PIC X(05) VALUE '  Q3 '.
               10  W0002-HDG1-PD04-08  PIC X(05) VALUE '  Q4 '.
               10  W0002-HDG1-PD04-09  PIC X(05) VALUE '  FY '.
               10  W0002-HDG1-PD04-10  PIC X(05) VALUE '     '.
               10  W0002-HDG1-PD04-11  PIC X(05) VALUE '     '.

           05  W0002-HDG2-PD04.
               10  W0002-HDG2-PD04-01  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD04-02  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD04-03  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD04-04  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD04-05  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD04-06  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD04-07  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD04-08  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD04-09  PIC X(05) VALUE 'TOTAL'.
               10  W0002-HDG2-PD04-10  PIC X(05) VALUE '     '.
               10  W0002-HDG2-PD04-11  PIC X(05) VALUE '     '.


           05  W0002-HDG1-PD05.
               10  W0002-HDG1-PD05-01  PIC X(05) VALUE '  Q1 '.
               10  W0002-HDG1-PD05-02  PIC X(05) VALUE '  P4 '.
               10  W0002-HDG1-PD05-03  PIC X(05) VALUE '  P5 '.
               10  W0002-HDG1-PD05-04  PIC X(05) VALUE '  P5 '.
               10  W0002-HDG1-PD05-05  PIC X(05) VALUE '  P6 '.
               10  W0002-HDG1-PD05-06  PIC X(05) VALUE '  Q2 '.
               10  W0002-HDG1-PD05-07  PIC X(05) VALUE '  Q3 '.
               10  W0002-HDG1-PD05-08  PIC X(05) VALUE '  Q4 '.
               10  W0002-HDG1-PD05-09  PIC X(05) VALUE '  FY '.
               10  W0002-HDG1-PD05-10  PIC X(05) VALUE '     '.
               10  W0002-HDG1-PD05-11  PIC X(05) VALUE '     '.

           05  W0002-HDG2-PD05.
               10  W0002-HDG2-PD05-01  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD05-02  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD05-03  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD05-04  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD05-05  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD05-06  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD05-07  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD05-08  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD05-09  PIC X(05) VALUE 'TOTAL'.
               10  W0002-HDG2-PD05-10  PIC X(05) VALUE '     '.
               10  W0002-HDG2-PD05-11  PIC X(05) VALUE '     '.


           05  W0002-HDG1-PD06.
               10  W0002-HDG1-PD06-01  PIC X(05) VALUE '  Q1 '.
               10  W0002-HDG1-PD06-02  PIC X(05) VALUE '  P4 '.
               10  W0002-HDG1-PD06-03  PIC X(05) VALUE '  P5 '.
               10  W0002-HDG1-PD06-04  PIC X(05) VALUE '  P6 '.
               10  W0002-HDG1-PD06-05  PIC X(05) VALUE '  P6 '.
               10  W0002-HDG1-PD06-06  PIC X(05) VALUE '  Q2 '.
               10  W0002-HDG1-PD06-07  PIC X(05) VALUE '  P7 '.
               10  W0002-HDG1-PD06-08  PIC X(05) VALUE '  P8 '.
               10  W0002-HDG1-PD06-09  PIC X(05) VALUE '  P9 '.
               10  W0002-HDG1-PD06-10  PIC X(05) VALUE '  Q4 '.
               10  W0002-HDG1-PD06-11  PIC X(05) VALUE '  FY '.

           05  W0002-HDG2-PD06.
               10  W0002-HDG2-PD06-01  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD06-02  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD06-03  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD06-04  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD06-05  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD06-06  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD06-07  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD06-08  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD06-09  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD06-10  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD06-11  PIC X(05) VALUE 'TOTAL'.


           05  W0002-HDG1-PD07.
               10  W0002-HDG1-PD07-01  PIC X(05) VALUE '  Q1 '.
               10  W0002-HDG1-PD07-02  PIC X(05) VALUE '  Q2 '.
               10  W0002-HDG1-PD07-03  PIC X(05) VALUE '  P7 '.
               10  W0002-HDG1-PD07-04  PIC X(05) VALUE '  P7 '.
               10  W0002-HDG1-PD07-05  PIC X(05) VALUE '  P8 '.
               10  W0002-HDG1-PD07-06  PIC X(05) VALUE '  P9 '.
               10  W0002-HDG1-PD07-07  PIC X(05) VALUE '  Q3 '.
               10  W0002-HDG1-PD07-08  PIC X(05) VALUE '  Q4 '.
               10  W0002-HDG1-PD07-09  PIC X(05) VALUE '  FY '.
               10  W0002-HDG1-PD07-10  PIC X(05) VALUE '     '.
               10  W0002-HDG1-PD07-11  PIC X(05) VALUE '     '.

           05  W0002-HDG2-PD07.
               10  W0002-HDG2-PD07-01  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD07-02  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD07-03  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD07-04  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD07-05  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD07-06  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD07-07  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD07-08  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD07-09  PIC X(05) VALUE 'TOTAL'.
               10  W0002-HDG2-PD07-10  PIC X(05) VALUE '     '.
               10  W0002-HDG2-PD07-11  PIC X(05) VALUE '     '.


           05  W0002-HDG1-PD08.
               10  W0002-HDG1-PD08-01  PIC X(05) VALUE '  Q1 '.
               10  W0002-HDG1-PD08-02  PIC X(05) VALUE '  Q2 '.
               10  W0002-HDG1-PD08-03  PIC X(05) VALUE '  P7 '.
               10  W0002-HDG1-PD08-04  PIC X(05) VALUE '  P8 '.
               10  W0002-HDG1-PD08-05  PIC X(05) VALUE '  P8 '.
               10  W0002-HDG1-PD08-06  PIC X(05) VALUE '  P9 '.
               10  W0002-HDG1-PD08-07  PIC X(05) VALUE '  Q3 '.
               10  W0002-HDG1-PD08-08  PIC X(05) VALUE '  Q4 '.
               10  W0002-HDG1-PD08-09  PIC X(05) VALUE '  FY '.
               10  W0002-HDG1-PD08-10  PIC X(05) VALUE '     '.
               10  W0002-HDG1-PD08-11  PIC X(05) VALUE '     '.

           05  W0002-HDG2-PD08.
               10  W0002-HDG2-PD08-01  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD08-02  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD08-03  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD08-04  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD08-05  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD08-06  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD08-07  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD08-08  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD08-09  PIC X(05) VALUE 'TOTAL'.
               10  W0002-HDG2-PD08-10  PIC X(05) VALUE '     '.
               10  W0002-HDG2-PD08-11  PIC X(05) VALUE '     '.


           05  W0002-HDG1-PD09.
               10  W0002-HDG1-PD09-01  PIC X(05) VALUE '  Q1 '.
               10  W0002-HDG1-PD09-02  PIC X(05) VALUE '  Q2 '.
               10  W0002-HDG1-PD09-03  PIC X(05) VALUE '  P7 '.
               10  W0002-HDG1-PD09-04  PIC X(05) VALUE '  P8 '.
               10  W0002-HDG1-PD09-05  PIC X(05) VALUE '  P9 '.
               10  W0002-HDG1-PD09-06  PIC X(05) VALUE '  P9 '.
               10  W0002-HDG1-PD09-07  PIC X(05) VALUE '  Q3 '.
               10  W0002-HDG1-PD09-08  PIC X(05) VALUE '  P10'.
               10  W0002-HDG1-PD09-09  PIC X(05) VALUE '  P11'.
               10  W0002-HDG1-PD09-10  PIC X(05) VALUE '  P12'.
               10  W0002-HDG1-PD09-11  PIC X(05) VALUE '  FY '.

           05  W0002-HDG2-PD09.
               10  W0002-HDG2-PD09-01  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD09-02  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD09-03  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD09-04  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD09-05  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD09-06  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD09-07  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD09-08  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD09-09  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD09-10  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD09-11  PIC X(05) VALUE 'TOTAL'.


           05  W0002-HDG1-PD10.
               10  W0002-HDG1-PD10-01  PIC X(05) VALUE '  Q1 '.
               10  W0002-HDG1-PD10-02  PIC X(05) VALUE '  Q2 '.
               10  W0002-HDG1-PD10-03  PIC X(05) VALUE '  Q3 '.
               10  W0002-HDG1-PD10-04  PIC X(05) VALUE '  P10'.
               10  W0002-HDG1-PD10-05  PIC X(05) VALUE '  P10'.
               10  W0002-HDG1-PD10-06  PIC X(05) VALUE '  P11'.
               10  W0002-HDG1-PD10-07  PIC X(05) VALUE '  P12'.
               10  W0002-HDG1-PD10-08  PIC X(05) VALUE '  Q4 '.
               10  W0002-HDG1-PD10-09  PIC X(05) VALUE '  FY '.
               10  W0002-HDG1-PD10-10  PIC X(05) VALUE '  Q1 '.
               10  W0002-HDG1-PD10-11  PIC X(05) VALUE '     '.

           05  W0002-HDG2-PD10.
               10  W0002-HDG2-PD10-01  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD10-02  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD10-03  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD10-04  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD10-05  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD10-06  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD10-07  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD10-08  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD10-09  PIC X(05) VALUE 'TOTAL'.
               10  W0002-HDG2-PD10-10  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD10-11  PIC X(05) VALUE '     '.


           05  W0002-HDG1-PD11.
               10  W0002-HDG1-PD11-01  PIC X(05) VALUE '  Q1 '.
               10  W0002-HDG1-PD11-02  PIC X(05) VALUE '  Q2 '.
               10  W0002-HDG1-PD11-03  PIC X(05) VALUE '  Q3 '.
               10  W0002-HDG1-PD11-04  PIC X(05) VALUE '  P10'.
               10  W0002-HDG1-PD11-05  PIC X(05) VALUE '  P11'.
               10  W0002-HDG1-PD11-06  PIC X(05) VALUE '  P11'.
               10  W0002-HDG1-PD11-07  PIC X(05) VALUE '  P12'.
               10  W0002-HDG1-PD11-08  PIC X(05) VALUE '  Q4 '.
               10  W0002-HDG1-PD11-09  PIC X(05) VALUE '  FY '.
               10  W0002-HDG1-PD11-10  PIC X(05) VALUE '  Q1 '.
               10  W0002-HDG1-PD11-11  PIC X(05) VALUE '     '.

           05  W0002-HDG2-PD11.
               10  W0002-HDG2-PD11-01  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD11-02  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD11-03  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD11-04  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD11-05  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD11-06  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD11-07  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD11-08  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD11-09  PIC X(05) VALUE 'TOTAL'.
               10  W0002-HDG2-PD11-10  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD11-11  PIC X(05) VALUE '     '.


           05  W0002-HDG1-PD12.
               10  W0002-HDG1-PD12-01  PIC X(05) VALUE '  1H '.
               10  W0002-HDG1-PD12-02  PIC X(05) VALUE '  Q3 '.
               10  W0002-HDG1-PD12-03  PIC X(05) VALUE '  P10'.
               10  W0002-HDG1-PD12-04  PIC X(05) VALUE '  P11'.
               10  W0002-HDG1-PD12-05  PIC X(05) VALUE '  P12'.
               10  W0002-HDG1-PD12-06  PIC X(05) VALUE '  P12'.
               10  W0002-HDG1-PD12-07  PIC X(05) VALUE '  Q4 '.
               10  W0002-HDG1-PD12-08  PIC X(05) VALUE '  FY '.
               10  W0002-HDG1-PD12-09  PIC X(05) VALUE '  P1 '.
               10  W0002-HDG1-PD12-10  PIC X(05) VALUE '  P2 '.
               10  W0002-HDG1-PD12-11  PIC X(05) VALUE '  P3 '.

           05  W0002-HDG2-PD12.
               10  W0002-HDG2-PD12-01  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD12-02  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD12-03  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD12-04  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD12-05  PIC X(05) VALUE '  ACT'.
               10  W0002-HDG2-PD12-06  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD12-07  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD12-08  PIC X(05) VALUE 'TOTAL'.
               10  W0002-HDG2-PD12-09  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD12-10  PIC X(05) VALUE ' FCST'.
               10  W0002-HDG2-PD12-11  PIC X(05) VALUE ' FCST'.

      ***************************************************************
      *                                                             *
      *    PROGRAM MAP AREA                                         *
      *                                                             *
      ***************************************************************
           COPY M108M07.

           EJECT
      **===========================================================**
      **   DATE ROUTINE.                                           **
      **===========================================================**
           COPY NSDTREC.

           EJECT
      ***************************************************************
      *                                                             *
      *    CICS COPYBOOKS AREA                                      *
      *                                                             *
      ***************************************************************
           COPY C108CDBA.

           EJECT
           COPY DFHAID.

           EJECT
           COPY C751CONW.

           EJECT
           COPY C108MSGS.

           EJECT
           COPY C108WTXN.

           EJECT
           COPY C108W900.

           EJECT
           COPY C108W998.

           EJECT
           COPY D972ERRM.

           EJECT
      ***************************************************************
      *                                                             *
      *    WORKING STORAGE COMMAREA                                 *
      *                                                             *
      ***************************************************************
           COPY C108COMM.
               10  TOT-SAVE-AREA REDEFINES CA-MAP-SAVE-AREA.
      ***************************************************************
      *                                                             *
      *  IMPORTANT!!! - THIS PROGRAM CALLS P108MT30 FOR THE HELP    *
      *  SCREEN AND USES FIELDS FROM THE COMMAREA.  MAKE SURE TO    *
      *  KEEP THE TWO LAYOUTS IN SYNC.                              *
      *                                                             *
      ***************************************************************
                   15  OLD-FISCAL-PERIOD            PIC  9(002).

                   15  CA-S-M-UID-CI                PIC  X(010).
                   15  CA-S-M-FCSID-NI              PIC  X(005).
                   15  CA-S-M-FCSID-XI              PIC  X(020).
                   15  CA-S-M-MAIN-MODEI            PIC  X(007).
                   15  CA-S-M-MKTCBU-CI             PIC  X(003).
                   15  CA-S-M-MKTCDIV-CI            PIC  X(002).
                   15  CA-S-M-MKTCRGN-CI            PIC  X(002).
                   15  CA-S-M-MKTCRGN-XI            PIC  X(020).
                   15  CA-S-M-CMNT-XI               PIC  X(050).
                   15  CA-S-M-DPT-CI                PIC  X(004).
                   15  CA-S-M-DPT-XI                PIC  X(020).
                   15  CA-S-M-SUBDPT-CI             PIC  X(003).
                   15  CA-S-M-EXPTYP-CI             PIC  X(002).
                   15  CA-S-M-EXPSUBTYP-CI          PIC  X(003).
                   15  CA-S-M-EXPSUB-XI             PIC  X(020).
                   15  CA-S-M-MGRNM-XI              PIC  X(025).
                   15  CA-S-M-BADGE-CI              PIC  X(006).
                   15  CA-S-M-MGRUID-CI             PIC  X(010).
                   15  CA-S-M-F-PRJ-NI              PIC  X(010).
                   15  CA-S-M-STD-AI                PIC  X(007).
                   15  CA-S-M-FYSTD-AI              PIC  X(007).
                   15  CA-S-M-ATD-AI                PIC  X(007).
                   15  CA-S-M-PATOT-AI              PIC  X(007).
                   15  CA-S-M-MSG-24I               PIC  X(077).
                   15  CA-S-M-FCSP-TABLE OCCURS  11 TIMES.
                     20  CA-S-M-FCSP-AI PIC  X(6).

                   15  CA-S-FCSP00-A    PIC S9999V   USAGE COMP-3.
                   15  CA-S-FCSP01-A    PIC S9999V   USAGE COMP-3.
                   15  CA-S-FCSP02-A    PIC S9999V   USAGE COMP-3.
                   15  CA-S-FCSP03-A    PIC S9999V   USAGE COMP-3.
                   15  CA-S-FCSP04-A    PIC S9999V   USAGE COMP-3.
                   15  CA-S-FCSP05-A    PIC S9999V   USAGE COMP-3.
                   15  CA-S-FCSQ02-A    PIC S9999V   USAGE COMP-3.
                   15  CA-S-FCSQ03-A    PIC S9999V   USAGE COMP-3.
                   15  CA-S-FCSQ04-A    PIC S9999V   USAGE COMP-3.
                   15  CA-S-FCSQ05-A    PIC S9999V   USAGE COMP-3.

                   15  CA-P-ACTP01-A    PIC S9(9)V   USAGE COMP-3.
                   15  CA-P-ACTP02-A    PIC S9(9)V   USAGE COMP-3.
                   15  CA-P-ACTP03-A    PIC S9(9)V   USAGE COMP-3.
                   15  CA-P-ACTQ01-A    PIC S9(9)V   USAGE COMP-3.
                   15  CA-P-ACTH01-A    PIC S9(9)V   USAGE COMP-3.

                   15  CA-P-ACTP01-R    PIC S9(9)V99 USAGE COMP-3.
                   15  CA-P-ACTP02-R    PIC S9(9)V99 USAGE COMP-3.
                   15  CA-P-ACTP03-R    PIC S9(9)V99 USAGE COMP-3.
                   15  CA-P-ACTQ01-R    PIC S9(9)V99 USAGE COMP-3.
                   15  CA-P-ACTH01-R    PIC S9(9)V99 USAGE COMP-3.

                   15  CA-H-ACTP01-A    PIC S9(9)V   USAGE COMP-3.
                   15  CA-H-ACTP02-A    PIC S9(9)V   USAGE COMP-3.
                   15  CA-H-ACTP03-A    PIC S9(9)V   USAGE COMP-3.
                   15  CA-H-ACTP04-A    PIC S9(9)V   USAGE COMP-3.
                   15  CA-H-ACTP05-A    PIC S9(9)V   USAGE COMP-3.
                   15  CA-H-ACTP06-A    PIC S9(9)V   USAGE COMP-3.
                   15  CA-H-ACTP07-A    PIC S9(9)V   USAGE COMP-3.
                   15  CA-H-ACTP08-A    PIC S9(9)V   USAGE COMP-3.
                   15  CA-H-ACTP09-A    PIC S9(9)V   USAGE COMP-3.

                   15  CA-WINDOW-IN-USE-SW    PIC X.
                       88  CA-WINDOW-IN-USE    VALUE 'Y'.
                       88  CA-NO-WINDOW-IN-USE VALUE 'N'.
                   15  CA-SECURITY-FLAG    PIC X.
                       88  SECURITY-UNKNOWN    VALUE SPACE.
                       88  SECURITY-OK         VALUE 'X'.
                       88  SECURITY-NG         VALUE 'Y'.
                   15  CA-TFPRJHDR-STATUS  PIC X.
                       88  TFPRJHDR-OK         VALUE 'Y'.
                       88  TFPRJHDR-NO-DATA    VALUE 'N'.
                   15  CA-HELP-ID          PIC X.
                       88  HELP-PRODLN         VALUE 'P'.
                       88  HELP-EXPTYP         VALUE 'E'.
                   15  CA-EIBCPOSN             PIC S9(4) COMP.
                   15  CA-DCLTFFCSHDR-SAVE     PIC X(200).
                   15  CA-PF5-PASS                  PIC  X.
                       88  PF5-FIRST-PASS      VALUE 'Y'.
                       88  PF5-SECOND-PASS     VALUE 'N'.
                   15  CA-P108MT30-AREA             PIC  X(050).
                   15  FCST-ID-VALID-IND       PIC X.
                       88   GOOD-FCST-ID          VALUE 'G'.
                       88   BAD-FCST-ID           VALUE 'B'.
                   15  W0001-Q1A-SAVE   PIC  S9999V9.
                   15  W0001-H01A-SAVE  PIC  S9999V9.
           EJECT
      ***************************************************************
      *                                                             *
      *    DB2 INCLUDES                                             *
      *                                                             *
      ***************************************************************

           EXEC SQL
                INCLUDE SQLCA
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE TFAUDIT
           END-EXEC.

           EXEC SQL
                INCLUDE TFDIV
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE TFBIZUNT
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE TFRGN
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE TFPRODLN
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE TFEXPTYP
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE TFDFAULT
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE TFFCSHDR
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE TFFCSHST
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE TFPRJHDR
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE TFPRJACT
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE TFSECACS
           END-EXEC.

           EJECT
           EXEC SQL
                INCLUDE TFSECPRD
           END-EXEC.

           EJECT
      ***************************************************************
      * CSR_3 GETS THE AUDIT TRAIL INFORMATION.                     *
      ***************************************************************
           EXEC SQL
             DECLARE CSR_3 CURSOR FOR
              SELECT A.A_UID_C
                   , A.DB_UPD_D
                   , A.DB_UPD_T
                   , B.A_EMPNM_X
                FROM D108.TFAUDIT  A
                   , D108.TFSECACS B
               WHERE A.A_UID_C        = B.A_UID_C
                 AND A.DB_TBLNAME_X   = 'TFFCSHDR'
                 AND A.DB_ACTN_C      = 'U'
                 AND A.DB_DATAIMG_C   = 'A'
                 AND SUBSTR(HEX(SUBSTR(DB_DATAIMG_X,3,3)),1,5)
                     = :W0001-K7-F-FCSID-N
                 AND SUBSTR(A.DB_DATAIMG_X,1,2)
                     = :W0001-K7-F-MKTCRGN-C
               ORDER BY DB_UPD_D DESC
                      , DB_UPD_T DESC
           END-EXEC.

           EJECT
       LINKAGE SECTION.

       01  DFHCOMMAREA.
           05  FILLER                   PICTURE X(4096).

           EJECT
       PROCEDURE DIVISION.

       A000-MAINLINE.

           MOVE 'A000'      TO CA-PARAGRAPH-NBR.

           EXEC CICS HANDLE ABEND
                LABEL    (Z900-HANDLE-ERROR)
           END-EXEC.

           EXEC CICS HANDLE CONDITION
                ERROR    (Z900-HANDLE-ERROR)
                ILLOGIC  (Z900-HANDLE-ERROR)
                DSIDERR  (Z900-HANDLE-ERROR)
                INVREQ   (Z900-HANDLE-ERROR)
                IOERR    (Z900-HANDLE-ERROR)
                ISCINVREQ(Z900-HANDLE-ERROR)
                NOSPACE  (Z900-HANDLE-ERROR)
           END-EXEC.

           PERFORM A100-INITIALIZATION.

           IF  CA-CURRENT-PGM = PROGRAM-NAME
               PERFORM A300-ACCEPT-SCREEN
               IF  EIBAID NOT = DFHPF12
                   SET CA-NOT-PF12         TO TRUE
               END-IF
               PERFORM C100-VALIDATE-FCST-ID
               IF NO-ERRORS
               EVALUATE TRUE
                   WHEN EIBAID = DFHENTER
                        PERFORM B000-PROCESS-ENTER-KEY
                        IF  NO-ERRORS AND CA-UPDATE
                            PERFORM E000-PROCESS-UPD-KEY
                        END-IF
                   WHEN EIBAID = DFHCLEAR
                        PERFORM Y400-RETURN-TO-CICS
                   WHEN EIBAID = DFHPF1
                        MOVE W0001-FCST-ID TO CA-CURR-FCST-ID
                        MOVE SPACES     TO CA-CURR-PROJNBR-C
                        MOVE FCST-ACCR-TXN-ID  TO W0001-TXN-ID
                        PERFORM Y700-START-TRANSACTION
                   WHEN EIBAID = DFHPF2
      **=======================================================**
      **  PF2 IS USED FOR TESTING THE HEADING SCENARIOS        **
      **=======================================================**
                        IF  CA-APPLID = 'CICST1'
                        AND CA-SYSTEM-ADMINISTRATOR
                            IF  CA-FISCAL-PERIOD = NSC-FISCAL-PERIOD
                                ADD 1 TO NSC-FISCAL-PERIOD
                                IF  NSC-FISCAL-PERIOD = 13
                                    MOVE 1 TO NSC-FISCAL-PERIOD
                                END-IF
                            ELSE
                                ADD 1 TO CA-FISCAL-PERIOD
                                IF  CA-FISCAL-PERIOD = 13
                                    MOVE 1 TO CA-FISCAL-PERIOD
                                END-IF
                            END-IF
                        ELSE
                            SET ERRORS         TO TRUE
                            MOVE W9999-MSG-002 TO M-MSG-24I
                            MOVE -1            TO M-DPT-CL
                        END-IF
                   WHEN EIBAID = DFHPF3
                        MOVE MAIN-MENU-TXN-ID TO W0001-TXN-ID
                        PERFORM Y700-START-TRANSACTION
                   WHEN EIBAID = DFHPF4
                        MOVE  PRJ-HDR-TXN-ID       TO W0001-TXN-ID
                        PERFORM Y700-START-TRANSACTION
                   WHEN EIBAID = DFHPF5
                        MOVE W0001-FCST-ID      TO CA-CURR-FCST-ID
                        MOVE PRJ-DET-TXN-ID     TO W0001-TXN-ID
                        PERFORM Y700-START-TRANSACTION
                   WHEN EIBAID = DFHPF6
                        PERFORM D000-PROCESS-ADD-KEY
                   WHEN EIBAID = DFHPF7
                        PERFORM G000-PROCESS-DEL-KEY
                   WHEN EIBAID = DFHPF8
                        MOVE FCST-PRD-SUM-TXN-ID   TO W0001-TXN-ID
                        PERFORM Y700-START-TRANSACTION
                   WHEN EIBAID = DFHPF9
                        IF  CA-ENTRY OR CA-UPDATE
                            PERFORM H100-PROCESS-PF9-KEY
                        ELSE
                            SET ERRORS          TO TRUE
                            SET HELP-ERRORS     TO TRUE
                            MOVE W9999-MSG-109  TO M-MSG-24I
                        END-IF
                   WHEN EIBAID = DFHPF10
                        SET CA-ENTRY TO TRUE
                        PERFORM A250-RE-INIT-OUTPUT-VALUES
                   WHEN EIBAID = DFHPF12
                        IF  CA-PF12
                        OR  CA-PREV-TXN = HELP-SCREEN-TXN-ID
                            MOVE MAIN-MENU-TXN-ID  TO W0001-TXN-ID
                            PERFORM Y700-START-TRANSACTION
                        ELSE
                            SET CA-PF12         TO TRUE
                            MOVE CA-CURRENT-PGM TO CA-RETURN-PGM
                            MOVE CA-PREV-TXN    TO W0001-TXN-ID
                            PERFORM Y700-START-TRANSACTION
                        END-IF
                   WHEN OTHER
                        MOVE W9999-MSG-002  TO  M-MSG-24I
                        MOVE -1             TO  M-FCSID-NL
                        SET ERRORS TO TRUE
                        SET HELP-ERRORS TO TRUE
               END-EVALUATE
               END-IF
           END-IF.

           PERFORM A200-DISPLAY-SCREEN.

           PERFORM Y100-REPEAT-PROGRAM.

           EJECT
       A100-INITIALIZATION.

           MOVE 'A100'      TO CA-PARAGRAPH-NBR.

           IF  EIBCALEN NOT EQUAL ZEROES
               MOVE DFHCOMMAREA TO WS-COMMAREA
               INITIALIZE DCLTFFCSHDR
                          DCLTFPRJHDR
                          DCLTFFCSHST
               IF  CA-CURRENT-PGM = PROGRAM-NAME
                   CONTINUE
               ELSE
                   MOVE CA-CURRENT-PGM   TO  CA-PREV-PGM
                   MOVE CA-CURRENT-TXN   TO  CA-PREV-TXN
                   SET  SECURITY-UNKNOWN TO TRUE
               END-IF
           ELSE
               MOVE MAIN-ENTRY-TXN-ID TO W0001-TXN-ID
               PERFORM Y600-START-TRANSACTION
           END-IF.

           EJECT
       A200-DISPLAY-SCREEN.

           MOVE 'A200'      TO CA-PARAGRAPH-NBR.

           IF  CA-CURRENT-PGM = PROGRAM-NAME
               PERFORM A210-SAVE-MAP
           ELSE
               IF CA-PREV-TXN = HELP-SCREEN-TXN-ID
                  PERFORM A215-RESTORE-MAP
                  SET ERRORS TO TRUE
      **          < ERRORS TO TRUE TO BYPASS PERFORM N000 B4 DISPLAY >
               ELSE
                  INITIALIZE TOT-SAVE-AREA
                  INITIALIZE M108M07I
                  PERFORM A240-FIRST-TIME-PROCESSING
               END-IF
           END-IF.

           EXEC CICS HANDLE CONDITION
                MAPFAIL (Z100-MAPFAIL)
                ERROR   (Z200-NO-MAPFAIL)
           END-EXEC.

           IF ERRORS OR BAD-FCST-ID OR CA-PROMPT
               CONTINUE
           ELSE
               PERFORM N000-OUTPUT-MAP-AMOUNTS
           END-IF.

           PERFORM A230-REFORMAT-OUTPUT.

           IF  CA-PROMPT
               PERFORM A335-SET-ATTR-PROMPT-FCST-ID
           ELSE
               PERFORM A330-SET-ATTRIBUTES-NORMAL
           END-IF.

           IF  CA-CURRENT-PGM = PROGRAM-NAME
               IF HELP-ERRORS
                 EXEC CICS SEND
                    MAP    (MAP-NAME)
                    MAPSET (SET-NAME)
                    FROM   (M108M07I)
                    CURSOR (EIBCPOSN)
                 END-EXEC
              ELSE
                 EXEC CICS SEND
                    MAP    (MAP-NAME)
                    MAPSET (SET-NAME)
                    FROM   (M108M07I)
                    CURSOR
                 END-EXEC
              END-IF
           ELSE
               IF CA-PREV-TXN = HELP-SCREEN-TXN-ID
                  OR HELP-ERRORS
                 EXEC CICS SEND
                    MAP    (MAP-NAME)
                    MAPSET (SET-NAME)
                    FROM   (M108M07I)
                    ERASE
                    CURSOR(CA-EIBCPOSN)
                 END-EXEC
               ELSE
                 MOVE -1   TO   M-FCSID-NL
                 EXEC CICS SEND
                    MAP    (MAP-NAME)
                    MAPSET (SET-NAME)
                    FROM   (M108M07I)
                    ERASE
                    CURSOR
                 END-EXEC
              END-IF
           END-IF.

           EJECT
       A210-SAVE-MAP.

           MOVE 'A210'      TO CA-PARAGRAPH-NBR.

           MOVE M-UID-CI           TO CA-S-M-UID-CI.
           MOVE M-FCSID-NI         TO CA-S-M-FCSID-NI.
           MOVE M-FCSID-XI         TO CA-S-M-FCSID-XI.
           MOVE M-MAIN-MODEI       TO CA-S-M-MAIN-MODEI.
           MOVE M-MKTCBU-CI        TO CA-S-M-MKTCBU-CI.
           MOVE M-MKTCDIV-CI       TO CA-S-M-MKTCDIV-CI.
           MOVE M-MKTCRGN-CI       TO CA-S-M-MKTCRGN-CI.
           MOVE M-MKTCRGN-XI       TO CA-S-M-MKTCRGN-XI.
           MOVE M-CMNT-XI          TO CA-S-M-CMNT-XI .
           MOVE M-DPT-CI           TO CA-S-M-DPT-CI.
           MOVE M-DPT-XI           TO CA-S-M-DPT-XI.
           MOVE M-SUBDPT-CI        TO CA-S-M-SUBDPT-CI.
           MOVE M-EXPTYP-CI        TO CA-S-M-EXPTYP-CI.
           MOVE M-EXPSUBTYP-CI     TO CA-S-M-EXPSUBTYP-CI.
           MOVE M-EXPSUB-XI        TO CA-S-M-EXPSUB-XI.
           MOVE M-MGRNM-XI         TO CA-S-M-MGRNM-XI.
           MOVE M-BADGE-CI         TO CA-S-M-BADGE-CI.
           MOVE M-MGRUID-CI        TO CA-S-M-MGRUID-CI.
           MOVE M-F-PRJ-NI         TO CA-S-M-F-PRJ-NI.
           MOVE M-STD-AI           TO CA-S-M-STD-AI.
           MOVE M-FYSTD-AI         TO CA-S-M-FYSTD-AI.
           MOVE M-ATD-AI           TO CA-S-M-ATD-AI.
           MOVE M-PATOT-AI         TO CA-S-M-PATOT-AI.
           MOVE M-MSG-24I          TO CA-S-M-MSG-24I.
           MOVE W0001-FCST-ID      TO CA-FCSID-NUM.

           PERFORM VARYING  K  FROM 1 BY 1
             UNTIL K > WS-TIME-BUCKETS
              MOVE M-FCSP-AI (K)  TO CA-S-M-FCSP-AI (K)
           END-PERFORM.

           MOVE M-FCSID-NI
             TO CA-CURR-FCST-ID.
           MOVE M-F-PRJ-NI
             TO CA-CURR-PROJNBR-C.
           MOVE M-DPT-CI
             TO CA-CURR-PROD-LN.
           MOVE M-SUBDPT-CI
             TO CA-CURR-SUBPROD-LN.

           EJECT
       A215-RESTORE-MAP.

           MOVE 'A215'      TO CA-PARAGRAPH-NBR.

           MOVE CA-S-M-UID-CI       TO M-UID-CI.
           MOVE CA-S-M-FCSID-NI     TO M-FCSID-NI.
           MOVE CA-S-M-FCSID-XI     TO M-FCSID-XI.
           MOVE CA-S-M-MAIN-MODEI   TO M-MAIN-MODEI.
           MOVE CA-S-M-MKTCBU-CI    TO M-MKTCBU-CI.
           MOVE CA-S-M-MKTCDIV-CI   TO M-MKTCDIV-CI.
           MOVE CA-S-M-MKTCRGN-CI   TO M-MKTCRGN-CI.
           MOVE CA-S-M-MKTCRGN-XI   TO M-MKTCRGN-XI.
           MOVE CA-S-M-CMNT-XI      TO M-CMNT-XI .
           MOVE CA-S-M-DPT-CI       TO M-DPT-CI.
           MOVE CA-S-M-DPT-XI       TO M-DPT-XI.
           MOVE CA-S-M-SUBDPT-CI    TO M-SUBDPT-CI.
           MOVE CA-S-M-EXPTYP-CI    TO M-EXPTYP-CI.
           MOVE CA-S-M-EXPSUBTYP-CI TO M-EXPSUBTYP-CI.
           MOVE CA-S-M-EXPSUB-XI    TO M-EXPSUB-XI.
           MOVE CA-S-M-MGRNM-XI     TO M-MGRNM-XI.
           MOVE CA-S-M-BADGE-CI     TO M-BADGE-CI.
           MOVE CA-S-M-MGRUID-CI    TO M-MGRUID-CI.
           MOVE CA-S-M-F-PRJ-NI     TO M-F-PRJ-NI.
           MOVE CA-S-M-STD-AI       TO M-STD-AI.
           MOVE CA-S-M-FYSTD-AI     TO M-FYSTD-AI.
           MOVE CA-S-M-ATD-AI       TO M-ATD-AI.
           MOVE CA-S-M-PATOT-AI     TO M-PATOT-AI.
           MOVE CA-S-M-MSG-24I      TO M-MSG-24I.

           PERFORM VARYING  K  FROM 1 BY 1
             UNTIL K > WS-TIME-BUCKETS
              MOVE  CA-S-M-FCSP-AI (K)  TO M-FCSP-AI (K)
           END-PERFORM.

           EJECT
       A220-CLEAR-OUTPUT-FLDS.

           MOVE 'A220'      TO CA-PARAGRAPH-NBR.

           MOVE  SPACES         TO
                 M-FCSID-NI
                 M-FCSID-XI
                 M-MKTCBU-CI
                 M-MKTCDIV-CI
                 M-DPT-CI
                 M-SUBDPT-CI
                 M-MKTCBU-XI
                 M-MKTCDIV-XI
                 M-DPT-XI
                 M-EXPTYP-CI
                 M-EXPSUBTYP-CI
                 M-EXPSUB-XI
                 M-MGRNM-XI
                 M-BADGE-CI
                 M-MGRUID-CI
                 M-CMNT-XI
                 M-F-PRJ-NI
                 M-STD-AI
                 M-FYSTD-AI
                 M-ATD-AI
                 M-PATOT-AI.

           EJECT
       A230-REFORMAT-OUTPUT.

           MOVE 'A230'      TO CA-PARAGRAPH-NBR.

           MOVE CA-DATE     TO M-DATEI.
           MOVE CA-TIME     TO M-TIMEI.
           MOVE CA-OP-ID    TO M-UID-CI.

           MOVE CA-FISCAL-YEAR   TO M-CURRPD-DI(1:2).
           MOVE '/'              TO M-CURRPD-DI(3:1).
           MOVE CA-FISCAL-PERIOD TO M-CURRPD-DI(4:2).

           EVALUATE TRUE
               WHEN CA-ENTRY
                    MOVE 'ADD    '  TO  M-MAIN-MODEI
               WHEN CA-UPDATE
                    MOVE 'UPDATE '  TO  M-MAIN-MODEI
               WHEN CA-DELETE
                    MOVE 'DELETE '  TO  M-MAIN-MODEI
               WHEN CA-INQUIRY
                    MOVE 'VIEW   '  TO  M-MAIN-MODEI
               WHEN CA-PROMPT
                    MOVE 'PROMPT '  TO  M-MAIN-MODEI
           END-EVALUATE.

           IF  M-FCSID-XI =  SPACES
               MOVE ALL '_'         TO M-FCSID-XI
           ELSE
               MOVE M-FCSID-XI      TO W9998-DATA
               PERFORM Z998-MOVE-UNDERSCORES
               MOVE W9998-DATA      TO M-FCSID-XI
           END-IF.

           INSPECT M-FCSID-NI     REPLACING ALL SPACES BY '_'
           INSPECT M-DPT-CI       REPLACING ALL SPACES BY '_'
           INSPECT M-SUBDPT-CI    REPLACING ALL SPACES BY '_'
           INSPECT M-EXPTYP-CI    REPLACING ALL SPACES BY '_'
           INSPECT M-EXPSUBTYP-CI REPLACING ALL SPACES BY '_'
           INSPECT M-MGRUID-CI    REPLACING ALL SPACES BY '_'.

           MOVE M-CMNT-XI       TO W9998-DATA
           PERFORM Z998-MOVE-UNDERSCORES
           MOVE W9998-DATA      TO M-CMNT-XI.

      **=========================================================**
      ** LEAVE THE FORECAST VALUE FOR THE CURRENT MTS PERIOD     **
      ** UNPROTECTED UNTIL WEDNESDAY OF THE FINAL WEEK OF MTS,   **
      ** WHICH IS THE FIRST FISCAL WEEK FOR NSC.                 **
      **=========================================================**

           IF  CA-FISCAL-PERIOD = NSC-FISCAL-PERIOD
               EVALUATE CA-FISCAL-PERIOD
                   WHEN 01
                        MOVE W0002-HDG1-PD01 TO W0002-HDG
                        PERFORM A232-MOVE-HEADINGS-TO-SCREEN

                        MOVE W0002-HDG2-PD01 TO W0002-HDG
                        PERFORM A233-MOVE-HEADINGS-TO-SCREEN

                        MOVE ATTR-ALPHA-PROT-MDT   TO
                                M-FCSP-AA (01)
                                M-FCSP-AA (05)
                                M-FCSP-AA (09)
                                M-FCSP-AA (10)
                                M-FCSP-AA (11)

                        MOVE ATTR-ALPHA-UNPROT-MDT TO
                                M-FCSP-AA (02)
                                M-FCSP-AA (03)
                                M-FCSP-AA (04)
                                M-FCSP-AA (06)
                                M-FCSP-AA (07)
                                M-FCSP-AA (08)

                        INSPECT M-FCSP-AI (02)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (03)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (04)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (06)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (07)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (08)
                            REPLACING ALL ' ' BY '_'

                        MOVE SPACES  TO M-FCSP-AI (10)
                                        M-FCSP-AI (11)
                   WHEN 02
                        MOVE W0002-HDG1-PD02 TO W0002-HDG
                        PERFORM A232-MOVE-HEADINGS-TO-SCREEN

                        MOVE W0002-HDG2-PD02 TO W0002-HDG
                        PERFORM A233-MOVE-HEADINGS-TO-SCREEN

                        MOVE ATTR-ALPHA-PROT-MDT   TO
                                M-FCSP-AA (01)
                                M-FCSP-AA (02)
                                M-FCSP-AA (05)
                                M-FCSP-AA (09)
                                M-FCSP-AA (10)
                                M-FCSP-AA (11)

                        MOVE ATTR-ALPHA-UNPROT-MDT TO
                                M-FCSP-AA (03)
                                M-FCSP-AA (04)
                                M-FCSP-AA (06)
                                M-FCSP-AA (07)
                                M-FCSP-AA (08)

                        INSPECT M-FCSP-AI (03)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (04)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (06)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (07)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (08)
                            REPLACING ALL ' ' BY '_'

                        MOVE SPACES  TO M-FCSP-AI (10)
                                        M-FCSP-AI (11)
                   WHEN 03
                        MOVE W0002-HDG1-PD03 TO W0002-HDG
                        PERFORM A232-MOVE-HEADINGS-TO-SCREEN

                        MOVE W0002-HDG2-PD03 TO W0002-HDG
                        PERFORM A233-MOVE-HEADINGS-TO-SCREEN

                        MOVE ATTR-ALPHA-PROT-MDT   TO
                                M-FCSP-AA (01)
                                M-FCSP-AA (02)
                                M-FCSP-AA (03)
                                M-FCSP-AA (05)
                                M-FCSP-AA (11)

                        MOVE ATTR-ALPHA-UNPROT-MDT TO
                                M-FCSP-AA (04)
                                M-FCSP-AA (06)
                                M-FCSP-AA (07)
                                M-FCSP-AA (08)
                                M-FCSP-AA (09)
                                M-FCSP-AA (10)

                        INSPECT M-FCSP-AI (04)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (06)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (07)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (08)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (09)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (10)
                            REPLACING ALL ' ' BY '_'
                   WHEN 04
                        MOVE W0002-HDG1-PD04 TO W0002-HDG
                        PERFORM A232-MOVE-HEADINGS-TO-SCREEN

                        MOVE W0002-HDG2-PD04 TO W0002-HDG
                        PERFORM A233-MOVE-HEADINGS-TO-SCREEN

                        MOVE ATTR-ALPHA-PROT-MDT   TO
                                M-FCSP-AA (01)
                                M-FCSP-AA (02)
                                M-FCSP-AA (06)
                                M-FCSP-AA (09)
                                M-FCSP-AA (10)
                                M-FCSP-AA (11)

                        MOVE ATTR-ALPHA-UNPROT-MDT TO
                                M-FCSP-AA (03)
                                M-FCSP-AA (04)
                                M-FCSP-AA (05)
                                M-FCSP-AA (07)
                                M-FCSP-AA (08)

                        INSPECT M-FCSP-AI (03)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (04)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (05)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (07)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (08)
                            REPLACING ALL ' ' BY '_'

                        MOVE SPACES  TO M-FCSP-AI (10)
                                        M-FCSP-AI (11)
                   WHEN 05
                        MOVE W0002-HDG1-PD05 TO W0002-HDG
                        PERFORM A232-MOVE-HEADINGS-TO-SCREEN

                        MOVE W0002-HDG2-PD05 TO W0002-HDG
                        PERFORM A233-MOVE-HEADINGS-TO-SCREEN

                        MOVE ATTR-ALPHA-PROT-MDT   TO
                                M-FCSP-AA (01)
                                M-FCSP-AA (02)
                                M-FCSP-AA (03)
                                M-FCSP-AA (06)
                                M-FCSP-AA (09)
                                M-FCSP-AA (10)
                                M-FCSP-AA (11)

                        MOVE ATTR-ALPHA-UNPROT-MDT TO
                                M-FCSP-AA (04)
                                M-FCSP-AA (05)
                                M-FCSP-AA (07)
                                M-FCSP-AA (08)

                        INSPECT M-FCSP-AI (04)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (05)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (07)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (08)
                            REPLACING ALL ' ' BY '_'

                        MOVE SPACES  TO M-FCSP-AI (10)
                                        M-FCSP-AI (11)
                   WHEN 06
                        MOVE W0002-HDG1-PD06 TO W0002-HDG
                        PERFORM A232-MOVE-HEADINGS-TO-SCREEN

                        MOVE W0002-HDG2-PD06 TO W0002-HDG
                        PERFORM A233-MOVE-HEADINGS-TO-SCREEN

                        MOVE ATTR-ALPHA-PROT-MDT   TO
                                M-FCSP-AA (01)
                                M-FCSP-AA (02)
                                M-FCSP-AA (03)
                                M-FCSP-AA (04)
                                M-FCSP-AA (06)
                                M-FCSP-AA (11)

                        MOVE ATTR-ALPHA-UNPROT-MDT TO
                                M-FCSP-AA (05)
                                M-FCSP-AA (07)
                                M-FCSP-AA (08)
                                M-FCSP-AA (09)
                                M-FCSP-AA (10)

                        INSPECT M-FCSP-AI (05)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (07)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (08)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (09)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (10)
                            REPLACING ALL ' ' BY '_'
                   WHEN 07
                        MOVE W0002-HDG1-PD07 TO W0002-HDG
                        PERFORM A232-MOVE-HEADINGS-TO-SCREEN

                        MOVE W0002-HDG2-PD07 TO W0002-HDG
                        PERFORM A233-MOVE-HEADINGS-TO-SCREEN

                        MOVE ATTR-ALPHA-PROT-MDT   TO
                                M-FCSP-AA (01)
                                M-FCSP-AA (02)
                                M-FCSP-AA (03)
                                M-FCSP-AA (07)
                                M-FCSP-AA (08)
                                M-FCSP-AA (10)
                                M-FCSP-AA (11)

                        MOVE ATTR-ALPHA-UNPROT-MDT TO
                                M-FCSP-AA (04)
                                M-FCSP-AA (05)
                                M-FCSP-AA (06)
                                M-FCSP-AA (08)

                        INSPECT M-FCSP-AI (04)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (05)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (06)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (08)
                            REPLACING ALL ' ' BY '_'

                        MOVE SPACES  TO M-FCSP-AI (10)
                                        M-FCSP-AI (11)
                   WHEN 08
                        MOVE W0002-HDG1-PD08 TO W0002-HDG
                        PERFORM A232-MOVE-HEADINGS-TO-SCREEN

                        MOVE W0002-HDG2-PD08 TO W0002-HDG
                        PERFORM A233-MOVE-HEADINGS-TO-SCREEN

                        MOVE ATTR-ALPHA-PROT-MDT   TO
                                M-FCSP-AA (01)
                                M-FCSP-AA (02)
                                M-FCSP-AA (03)
                                M-FCSP-AA (04)
                                M-FCSP-AA (07)
                                M-FCSP-AA (09)
                                M-FCSP-AA (10)
                                M-FCSP-AA (11)

                        MOVE ATTR-ALPHA-UNPROT-MDT TO
                                M-FCSP-AA (05)
                                M-FCSP-AA (06)
                                M-FCSP-AA (08)

                        INSPECT M-FCSP-AI (05)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (06)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (08)
                            REPLACING ALL ' ' BY '_'

                        MOVE SPACES  TO M-FCSP-AI (10)
                                        M-FCSP-AI (11)
                   WHEN 09
                        MOVE W0002-HDG1-PD09 TO W0002-HDG
                        PERFORM A232-MOVE-HEADINGS-TO-SCREEN

                        MOVE W0002-HDG2-PD09 TO W0002-HDG
                        PERFORM A233-MOVE-HEADINGS-TO-SCREEN

                        MOVE ATTR-ALPHA-PROT-MDT   TO
                                M-FCSP-AA (01)
                                M-FCSP-AA (02)
                                M-FCSP-AA (03)
                                M-FCSP-AA (04)
                                M-FCSP-AA (05)
                                M-FCSP-AA (07)
                                M-FCSP-AA (11)

                        MOVE ATTR-ALPHA-UNPROT-MDT TO
                                M-FCSP-AA (06)
                                M-FCSP-AA (08)
                                M-FCSP-AA (09)
                                M-FCSP-AA (10)

                        INSPECT M-FCSP-AI (06)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (08)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (09)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (10)
                            REPLACING ALL ' ' BY '_'
                   WHEN 10
                        MOVE W0002-HDG1-PD10 TO W0002-HDG
                        PERFORM A232-MOVE-HEADINGS-TO-SCREEN

                        MOVE W0002-HDG2-PD10 TO W0002-HDG
                        PERFORM A233-MOVE-HEADINGS-TO-SCREEN

                        MOVE ATTR-ALPHA-PROT-MDT   TO
                                M-FCSP-AA (01)
                                M-FCSP-AA (02)
                                M-FCSP-AA (03)
                                M-FCSP-AA (04)
                                M-FCSP-AA (08)
                                M-FCSP-AA (09)
                                M-FCSP-AA (11)

                        MOVE ATTR-ALPHA-UNPROT-MDT TO
                                M-FCSP-AA (05)
                                M-FCSP-AA (06)
                                M-FCSP-AA (07)
                                M-FCSP-AA (10)

                        INSPECT M-FCSP-AI (05)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (06)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (07)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (10)
                            REPLACING ALL ' ' BY '_'

                        MOVE SPACES  TO M-FCSP-AI (11)
                   WHEN 11
                        MOVE W0002-HDG1-PD11 TO W0002-HDG
                        PERFORM A232-MOVE-HEADINGS-TO-SCREEN

                        MOVE W0002-HDG2-PD11 TO W0002-HDG
                        PERFORM A233-MOVE-HEADINGS-TO-SCREEN

                        MOVE ATTR-ALPHA-PROT-MDT   TO
                                M-FCSP-AA (01)
                                M-FCSP-AA (02)
                                M-FCSP-AA (03)
                                M-FCSP-AA (04)
                                M-FCSP-AA (05)
                                M-FCSP-AA (08)
                                M-FCSP-AA (09)
                                M-FCSP-AA (11)

                        MOVE ATTR-ALPHA-UNPROT-MDT TO
                                M-FCSP-AA (06)
                                M-FCSP-AA (07)
                                M-FCSP-AA (10)

                        INSPECT M-FCSP-AI (06)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (07)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (10)
                            REPLACING ALL ' ' BY '_'

                        MOVE SPACES  TO M-FCSP-AI (11)
                   WHEN 12
                        MOVE W0002-HDG1-PD12 TO W0002-HDG
                        PERFORM A232-MOVE-HEADINGS-TO-SCREEN

                        MOVE W0002-HDG2-PD12 TO W0002-HDG
                        PERFORM A233-MOVE-HEADINGS-TO-SCREEN

                        MOVE ATTR-ALPHA-PROT-MDT   TO
                                M-FCSP-AA (01)
                                M-FCSP-AA (02)
                                M-FCSP-AA (03)
                                M-FCSP-AA (04)
                                M-FCSP-AA (05)
                                M-FCSP-AA (07)
                                M-FCSP-AA (08)

                        MOVE ATTR-ALPHA-UNPROT-MDT TO
                                M-FCSP-AA (06)
                                M-FCSP-AA (09)
                                M-FCSP-AA (10)
                                M-FCSP-AA (11)

                        INSPECT M-FCSP-AI (06)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (09)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (10)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (11)
                            REPLACING ALL ' ' BY '_'
               END-EVALUATE
           ELSE
               EVALUATE CA-FISCAL-PERIOD
                   WHEN 01
                        MOVE W0002-HDG1-PD01 TO W0002-HDG
                        PERFORM A232-MOVE-HEADINGS-TO-SCREEN

                        MOVE W0002-HDG2-PD01 TO W0002-HDG
                        PERFORM A233-MOVE-HEADINGS-TO-SCREEN

                        MOVE ATTR-ALPHA-PROT-MDT   TO
                                M-FCSP-AA (01)
                                M-FCSP-AA (02)
                                M-FCSP-AA (05)
                                M-FCSP-AA (09)
                                M-FCSP-AA (10)
                                M-FCSP-AA (11)

                        MOVE ATTR-ALPHA-UNPROT-MDT TO
                                M-FCSP-AA (03)
                                M-FCSP-AA (04)
                                M-FCSP-AA (06)
                                M-FCSP-AA (07)
                                M-FCSP-AA (08)

                        INSPECT M-FCSP-AI (03)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (04)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (06)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (07)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (08)
                            REPLACING ALL ' ' BY '_'

                        MOVE SPACES  TO M-FCSP-AI (10)
                                        M-FCSP-AI (11)
                   WHEN 02
                        MOVE W0002-HDG1-PD02 TO W0002-HDG
                        PERFORM A232-MOVE-HEADINGS-TO-SCREEN

                        MOVE W0002-HDG2-PD02 TO W0002-HDG
                        PERFORM A233-MOVE-HEADINGS-TO-SCREEN

                        MOVE ATTR-ALPHA-PROT-MDT   TO
                                M-FCSP-AA (01)
                                M-FCSP-AA (02)
                                M-FCSP-AA (03)
                                M-FCSP-AA (05)
                                M-FCSP-AA (09)
                                M-FCSP-AA (10)
                                M-FCSP-AA (11)

                        MOVE ATTR-ALPHA-UNPROT-MDT TO
                                M-FCSP-AA (04)
                                M-FCSP-AA (06)
                                M-FCSP-AA (07)
                                M-FCSP-AA (08)

                        INSPECT M-FCSP-AI (04)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (06)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (07)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (08)
                            REPLACING ALL ' ' BY '_'

                        MOVE SPACES  TO M-FCSP-AI (10)
                                        M-FCSP-AI (11)
                   WHEN 03
                        MOVE W0002-HDG1-PD03 TO W0002-HDG
                        PERFORM A232-MOVE-HEADINGS-TO-SCREEN

                        MOVE W0002-HDG2-PD03 TO W0002-HDG
                        PERFORM A233-MOVE-HEADINGS-TO-SCREEN

                        MOVE ATTR-ALPHA-PROT-MDT   TO
                                M-FCSP-AA (01)
                                M-FCSP-AA (02)
                                M-FCSP-AA (03)
                                M-FCSP-AA (04)
                                M-FCSP-AA (05)
                                M-FCSP-AA (11)

                        MOVE ATTR-ALPHA-UNPROT-MDT TO
                                M-FCSP-AA (06)
                                M-FCSP-AA (07)
                                M-FCSP-AA (08)
                                M-FCSP-AA (09)
                                M-FCSP-AA (10)

                        INSPECT M-FCSP-AI (06)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (07)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (08)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (09)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (10)
                            REPLACING ALL ' ' BY '_'
                   WHEN 04
                        MOVE W0002-HDG1-PD04 TO W0002-HDG
                        PERFORM A232-MOVE-HEADINGS-TO-SCREEN

                        MOVE W0002-HDG2-PD04 TO W0002-HDG
                        PERFORM A233-MOVE-HEADINGS-TO-SCREEN

                        MOVE ATTR-ALPHA-PROT-MDT   TO
                                M-FCSP-AA (01)
                                M-FCSP-AA (02)
                                M-FCSP-AA (03)
                                M-FCSP-AA (06)
                                M-FCSP-AA (09)
                                M-FCSP-AA (10)
                                M-FCSP-AA (11)

                        MOVE ATTR-ALPHA-UNPROT-MDT TO
                                M-FCSP-AA (04)
                                M-FCSP-AA (05)
                                M-FCSP-AA (07)
                                M-FCSP-AA (08)

                        INSPECT M-FCSP-AI (04)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (05)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (07)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (08)
                            REPLACING ALL ' ' BY '_'

                        MOVE SPACES  TO M-FCSP-AI (10)
                                        M-FCSP-AI (11)
                   WHEN 05
                        MOVE W0002-HDG1-PD05 TO W0002-HDG
                        PERFORM A232-MOVE-HEADINGS-TO-SCREEN

                        MOVE W0002-HDG2-PD05 TO W0002-HDG
                        PERFORM A233-MOVE-HEADINGS-TO-SCREEN

                        MOVE ATTR-ALPHA-PROT-MDT   TO
                                M-FCSP-AA (01)
                                M-FCSP-AA (02)
                                M-FCSP-AA (03)
                                M-FCSP-AA (04)
                                M-FCSP-AA (06)
                                M-FCSP-AA (09)
                                M-FCSP-AA (10)
                                M-FCSP-AA (11)

                        MOVE ATTR-ALPHA-UNPROT-MDT TO
                                M-FCSP-AA (05)
                                M-FCSP-AA (07)
                                M-FCSP-AA (08)

                        INSPECT M-FCSP-AI (05)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (07)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (08)
                            REPLACING ALL ' ' BY '_'

                        MOVE SPACES  TO M-FCSP-AI (10)
                                        M-FCSP-AI (11)
                   WHEN 06
                        MOVE W0002-HDG1-PD06 TO W0002-HDG
                        PERFORM A232-MOVE-HEADINGS-TO-SCREEN

                        MOVE W0002-HDG2-PD06 TO W0002-HDG
                        PERFORM A233-MOVE-HEADINGS-TO-SCREEN

                        MOVE ATTR-ALPHA-PROT-MDT   TO
                                M-FCSP-AA (01)
                                M-FCSP-AA (02)
                                M-FCSP-AA (03)
                                M-FCSP-AA (04)
                                M-FCSP-AA (05)
                                M-FCSP-AA (06)
                                M-FCSP-AA (11)

                        MOVE ATTR-ALPHA-UNPROT-MDT TO
                                M-FCSP-AA (07)
                                M-FCSP-AA (08)
                                M-FCSP-AA (09)
                                M-FCSP-AA (10)

                        INSPECT M-FCSP-AI (07)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (08)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (09)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (10)
                            REPLACING ALL ' ' BY '_'
                   WHEN 07
                        MOVE W0002-HDG1-PD07 TO W0002-HDG
                        PERFORM A232-MOVE-HEADINGS-TO-SCREEN

                        MOVE W0002-HDG2-PD07 TO W0002-HDG
                        PERFORM A233-MOVE-HEADINGS-TO-SCREEN

                        MOVE ATTR-ALPHA-PROT-MDT   TO
                                M-FCSP-AA (01)
                                M-FCSP-AA (02)
                                M-FCSP-AA (03)
                                M-FCSP-AA (04)
                                M-FCSP-AA (07)
                                M-FCSP-AA (08)
                                M-FCSP-AA (10)
                                M-FCSP-AA (11)

                        MOVE ATTR-ALPHA-UNPROT-MDT TO
                                M-FCSP-AA (05)
                                M-FCSP-AA (06)
                                M-FCSP-AA (08)

                        INSPECT M-FCSP-AI (05)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (06)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (08)
                            REPLACING ALL ' ' BY '_'

                        MOVE SPACES  TO M-FCSP-AI (10)
                                        M-FCSP-AI (11)
                   WHEN 08
                        MOVE W0002-HDG1-PD08 TO W0002-HDG
                        PERFORM A232-MOVE-HEADINGS-TO-SCREEN

                        MOVE W0002-HDG2-PD08 TO W0002-HDG
                        PERFORM A233-MOVE-HEADINGS-TO-SCREEN

                        MOVE ATTR-ALPHA-PROT-MDT   TO
                                M-FCSP-AA (01)
                                M-FCSP-AA (02)
                                M-FCSP-AA (03)
                                M-FCSP-AA (04)
                                M-FCSP-AA (05)
                                M-FCSP-AA (07)
                                M-FCSP-AA (09)
                                M-FCSP-AA (10)
                                M-FCSP-AA (11)

                        MOVE ATTR-ALPHA-UNPROT-MDT TO
                                M-FCSP-AA (06)
                                M-FCSP-AA (08)

                        INSPECT M-FCSP-AI (06)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (08)
                            REPLACING ALL ' ' BY '_'

                        MOVE SPACES  TO M-FCSP-AI (10)
                                        M-FCSP-AI (11)
                   WHEN 09
                        MOVE W0002-HDG1-PD09 TO W0002-HDG
                        PERFORM A232-MOVE-HEADINGS-TO-SCREEN

                        MOVE W0002-HDG2-PD09 TO W0002-HDG
                        PERFORM A233-MOVE-HEADINGS-TO-SCREEN

                        MOVE ATTR-ALPHA-PROT-MDT   TO
                                M-FCSP-AA (01)
                                M-FCSP-AA (02)
                                M-FCSP-AA (03)
                                M-FCSP-AA (04)
                                M-FCSP-AA (05)
                                M-FCSP-AA (06)
                                M-FCSP-AA (07)
                                M-FCSP-AA (11)

                        MOVE ATTR-ALPHA-UNPROT-MDT TO
                                M-FCSP-AA (08)
                                M-FCSP-AA (09)
                                M-FCSP-AA (10)

                        INSPECT M-FCSP-AI (08)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (09)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (10)
                            REPLACING ALL ' ' BY '_'
                   WHEN 10
                        MOVE W0002-HDG1-PD10 TO W0002-HDG
                        PERFORM A232-MOVE-HEADINGS-TO-SCREEN

                        MOVE W0002-HDG2-PD10 TO W0002-HDG
                        PERFORM A233-MOVE-HEADINGS-TO-SCREEN

                        MOVE ATTR-ALPHA-PROT-MDT   TO
                                M-FCSP-AA (01)
                                M-FCSP-AA (02)
                                M-FCSP-AA (03)
                                M-FCSP-AA (04)
                                M-FCSP-AA (05)
                                M-FCSP-AA (08)
                                M-FCSP-AA (09)
                                M-FCSP-AA (11)

                        MOVE ATTR-ALPHA-UNPROT-MDT TO
                                M-FCSP-AA (06)
                                M-FCSP-AA (07)
                                M-FCSP-AA (10)

                        INSPECT M-FCSP-AI (06)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (07)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (10)
                            REPLACING ALL ' ' BY '_'

                        MOVE SPACES  TO M-FCSP-AI (11)
                   WHEN 11
                        MOVE W0002-HDG1-PD11 TO W0002-HDG
                        PERFORM A232-MOVE-HEADINGS-TO-SCREEN

                        MOVE W0002-HDG2-PD11 TO W0002-HDG
                        PERFORM A233-MOVE-HEADINGS-TO-SCREEN

                        MOVE ATTR-ALPHA-PROT-MDT   TO
                                M-FCSP-AA (01)
                                M-FCSP-AA (02)
                                M-FCSP-AA (03)
                                M-FCSP-AA (04)
                                M-FCSP-AA (05)
                                M-FCSP-AA (06)
                                M-FCSP-AA (08)
                                M-FCSP-AA (09)
                                M-FCSP-AA (11)

                        MOVE ATTR-ALPHA-UNPROT-MDT TO
                                M-FCSP-AA (07)
                                M-FCSP-AA (10)

                        INSPECT M-FCSP-AI (07)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (10)
                            REPLACING ALL ' ' BY '_'

                        MOVE SPACES  TO M-FCSP-AI (11)
                   WHEN 12
                        MOVE W0002-HDG1-PD12 TO W0002-HDG
                        PERFORM A232-MOVE-HEADINGS-TO-SCREEN

                        MOVE W0002-HDG2-PD12 TO W0002-HDG
                        PERFORM A233-MOVE-HEADINGS-TO-SCREEN

                        MOVE ATTR-ALPHA-PROT-MDT   TO
                                M-FCSP-AA (01)
                                M-FCSP-AA (02)
                                M-FCSP-AA (03)
                                M-FCSP-AA (04)
                                M-FCSP-AA (05)
                                M-FCSP-AA (06)
                                M-FCSP-AA (07)
                                M-FCSP-AA (08)

                        MOVE ATTR-ALPHA-UNPROT-MDT TO
                                M-FCSP-AA (09)
                                M-FCSP-AA (10)
                                M-FCSP-AA (11)

                        INSPECT M-FCSP-AI (09)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (10)
                            REPLACING ALL ' ' BY '_'
                        INSPECT M-FCSP-AI (11)
                            REPLACING ALL ' ' BY '_'
               END-EVALUATE
           END-IF.

           EJECT
       A232-MOVE-HEADINGS-TO-SCREEN.

           MOVE 'A232'      TO CA-PARAGRAPH-NBR.

           MOVE W0002-HDG-01 TO M-HDG1-XI(01).
           MOVE W0002-HDG-02 TO M-HDG1-XI(02).
           MOVE W0002-HDG-03 TO M-HDG1-XI(03).
           MOVE W0002-HDG-04 TO M-HDG1-XI(04).
           MOVE W0002-HDG-05 TO M-HDG1-XI(05).
           MOVE W0002-HDG-06 TO M-HDG1-XI(06).
           MOVE W0002-HDG-07 TO M-HDG1-XI(07).
           MOVE W0002-HDG-08 TO M-HDG1-XI(08).
           MOVE W0002-HDG-09 TO M-HDG1-XI(09).
           MOVE W0002-HDG-10 TO M-HDG1-XI(10).
           MOVE W0002-HDG-11 TO M-HDG1-XI(11).

           EJECT
       A233-MOVE-HEADINGS-TO-SCREEN.

           MOVE 'A233'      TO CA-PARAGRAPH-NBR.

           MOVE W0002-HDG-01 TO M-HDG2-XI(01).
           MOVE W0002-HDG-02 TO M-HDG2-XI(02).
           MOVE W0002-HDG-03 TO M-HDG2-XI(03).
           MOVE W0002-HDG-04 TO M-HDG2-XI(04).
           MOVE W0002-HDG-05 TO M-HDG2-XI(05).
           MOVE W0002-HDG-06 TO M-HDG2-XI(06).
           MOVE W0002-HDG-07 TO M-HDG2-XI(07).
           MOVE W0002-HDG-08 TO M-HDG2-XI(08).
           MOVE W0002-HDG-09 TO M-HDG2-XI(09).
           MOVE W0002-HDG-10 TO M-HDG2-XI(10).
           MOVE W0002-HDG-11 TO M-HDG2-XI(11).


           EJECT
       A240-FIRST-TIME-PROCESSING.

           MOVE 'A240'      TO CA-PARAGRAPH-NBR.

           EXEC CICS ASKTIME
                ABSTIME (W0001-ABSTIME)
           END-EXEC.

           EXEC CICS FORMATTIME
                ABSTIME (W0001-ABSTIME)
                TIME    (W0001-HHCMMCSS)
                TIMESEP
                MMDDYY  (W0001-MMSDDSYY)
                DATESEP
                YEAR    (W0001-YYYY)
           END-EXEC.

           MOVE W0001-MMSDDSYY    TO M-DATEI
                                     CA-DATE.
           MOVE W0001-HHCMMCSS    TO M-TIMEI
                                     CA-TIME.

           SET GOOD-FCST-ID       TO TRUE.
           PERFORM VARYING K FROM 1 BY 1
             UNTIL K > WS-TIME-BUCKETS
                  MOVE  ZERO TO W0001-FCSP-AI (K)
           END-PERFORM.

           MOVE ZEROS      TO W0001-STD-AI
           MOVE ZEROS      TO W0001-YTD-AI
                              W0001-ATD-AI
                              W0001-PATOT-AI.

           MOVE CA-OP-RGN  TO M-MKTCRGN-CI.
           PERFORM C120-VALIDATE-REGION

           EVALUATE TRUE
               WHEN CA-ENTRY
                    PERFORM A220-CLEAR-OUTPUT-FLDS
                    MOVE CA-OP-ID      TO M-MGRUID-CI
                    MOVE CA-A-BADGE-N  TO M-BADGE-CI
                    MOVE CA-A-EMPNM-X  TO M-MGRNM-XI
                    PERFORM C060-GET-HEADER-INFO-ADD
                    MOVE -1            TO M-FCSID-XL
                    MOVE W9999-MSG-043 TO M-MSG-24I
                    PERFORM VARYING  K FROM 1 BY 1
                      UNTIL K > WS-TIME-BUCKETS
                       MOVE ZEROES             TO W0001-FCSP-AI (K)
                       MOVE W0001-FCSP-AI (K)  TO W0001-FCSP-AI-D41
                       MOVE W0001-FCSP-AI-D41  TO M-FCSP-AI (K)
                    END-PERFORM
               WHEN CA-UPDATE OR CA-INQUIRY
                    IF  CA-CURR-FCST-ID = SPACES OR LOW-VALUES OR ZEROS
                        PERFORM E025-PROMPT-FCST-ID
                    ELSE
                        MOVE CA-CURR-FCST-ID   TO M-FCSID-NI
                        PERFORM C100-VALIDATE-FCST-ID
                        IF  NO-ERRORS
                            PERFORM A250-RE-INIT-OUTPUT-VALUES
                        END-IF
                    END-IF
               WHEN CA-DELETE
                    PERFORM E025-PROMPT-FCST-ID
               WHEN OTHER
                    MOVE W9999-BAD-MESSAGE-TEXT  TO M-MSG-24I
                    MOVE -1                      TO M-FCSID-NL
           END-EVALUATE.

           EJECT
       A250-RE-INIT-OUTPUT-VALUES.

           MOVE 'A250'      TO CA-PARAGRAPH-NBR.

           IF  CA-ENTRY
               PERFORM A220-CLEAR-OUTPUT-FLDS
               MOVE CA-OP-ID       TO M-MGRUID-CI
               MOVE CA-A-BADGE-N   TO M-BADGE-CI
               MOVE CA-A-EMPNM-X   TO M-MGRNM-XI
               PERFORM C060-GET-HEADER-INFO-ADD
               PERFORM VARYING  K FROM 1 BY 1
                 UNTIL K > WS-TIME-BUCKETS
                  MOVE ZEROES             TO W0001-FCSP-AI (K)
                  MOVE W0001-FCSP-AI (K)  TO W0001-FCSP-AI-D41
                  MOVE W0001-FCSP-AI-D41  TO M-FCSP-AI (K)
               END-PERFORM
               MOVE -1             TO M-FCSID-XL
               MOVE W9999-MSG-043  TO M-MSG-24I
           ELSE
               PERFORM E110-RETRIEVE-FCST-DATA
               IF  NO-ERRORS
                   EVALUATE TRUE
                       WHEN CA-UPDATE
                            MOVE W9999-MSG-141    TO M-MSG-24I
                            MOVE -1               TO M-FCSID-XL
                       WHEN CA-INQUIRY
                            MOVE W9999-MSG-049    TO M-MSG-24I
                            MOVE -1               TO M-FCSID-NL
                       WHEN CA-DELETE
                            PERFORM A260-VERIFY-DELETE-REQUEST
                            IF  NO-ERRORS
                                MOVE W9999-MSG-050 TO M-MSG-24I
                                MOVE -1            TO M-FCSID-NL
                            END-IF
                   END-EVALUATE
                   MOVE W0001-FCST-ID  TO CA-CURR-FCST-ID
               END-IF
           END-IF.

           EJECT
       A260-VERIFY-DELETE-REQUEST.

           MOVE 'A260'      TO CA-PARAGRAPH-NBR.

           IF TFPRJHDR-OK
              MOVE P-ACTP01-A IN DCLTFPRJHDR TO W0001-HOLD1
              MOVE P-ACTP02-A IN DCLTFPRJHDR TO W0001-HOLD2
              MOVE P-ACTP03-A IN DCLTFPRJHDR TO W0001-HOLD3
              MOVE P-ACTQ01-A IN DCLTFPRJHDR TO W0001-HOLD4
              MOVE P-ACTH01-A IN DCLTFPRJHDR TO W0001-HOLD5
              IF  (  W0001-HOLD1  =  ZEROS AND
                     W0001-HOLD2  =  ZEROS AND
                     W0001-HOLD3  =  ZEROS AND
                     W0001-HOLD4  =  ZEROS AND
                     W0001-HOLD5  =  ZEROS
                  )
                  IF CA-SYSTEM-ADMINISTRATOR
                     CONTINUE
                  ELSE
                     SET ERRORS TO TRUE
                     MOVE W9999-MSG-106   TO  M-MSG-24I
                     MOVE -1              TO  M-FCSID-NL
                  END-IF
             ELSE
                SET ERRORS TO TRUE
                MOVE W9999-MSG-106   TO  M-MSG-24I
                MOVE -1              TO  M-FCSID-NL
             END-IF
           ELSE
               MOVE  ZEROES          TO W0001-HOLD1
               MOVE  ZEROES          TO W0001-HOLD2
               MOVE  ZEROES          TO W0001-HOLD3
               MOVE  ZEROES          TO W0001-HOLD4
               MOVE  ZEROES          TO W0001-HOLD5
           END-IF.
           EJECT
       A300-ACCEPT-SCREEN.

           MOVE 'A300'      TO CA-PARAGRAPH-NBR.

           EXEC CICS IGNORE CONDITION
                MAPFAIL
           END-EXEC.

           EXEC CICS HANDLE CONDITION
                ERROR (Z200-NO-MAPFAIL)
           END-EXEC.

           EXEC CICS RECEIVE
                MAP    (MAP-NAME)
                MAPSET (SET-NAME)
                INTO   (M108M07I)
           END-EXEC.
           PERFORM A320-REFORMAT-INPUT.
           EJECT
       A320-REFORMAT-INPUT.

           MOVE 'A320'      TO CA-PARAGRAPH-NBR.

           INSPECT M-FCSID-NI      REPLACING ALL '_' BY SPACES.
           INSPECT M-FCSID-XI      REPLACING ALL '_' BY SPACES.
           INSPECT M-MKTCBU-CI     REPLACING ALL '_' BY SPACES.
           INSPECT M-MKTCDIV-CI    REPLACING ALL '_' BY SPACES.
           INSPECT M-MKTCRGN-CI    REPLACING ALL '_' BY SPACES.
           INSPECT M-DPT-CI        REPLACING ALL '_' BY SPACES.
           INSPECT M-SUBDPT-CI     REPLACING ALL '_' BY SPACES.
           INSPECT M-EXPTYP-CI     REPLACING ALL '_' BY SPACES.
           INSPECT M-EXPSUBTYP-CI  REPLACING ALL '_' BY SPACES.
           INSPECT M-MGRNM-XI      REPLACING ALL '_' BY SPACES.
           INSPECT M-BADGE-CI      REPLACING ALL '_' BY SPACES.
           INSPECT M-MGRUID-CI     REPLACING ALL '_' BY SPACES.
           INSPECT M-CMNT-XI       REPLACING ALL '_' BY SPACES.

           INSPECT M-FCSID-NI     REPLACING ALL LOW-VALUES BY SPACES.
           INSPECT M-FCSID-XI     REPLACING ALL LOW-VALUES BY SPACES.
           INSPECT M-MKTCBU-CI    REPLACING ALL LOW-VALUES BY SPACES.
           INSPECT M-MKTCDIV-CI   REPLACING ALL LOW-VALUES BY SPACES.
           INSPECT M-MKTCRGN-CI   REPLACING ALL LOW-VALUES BY SPACES.
           INSPECT M-DPT-CI       REPLACING ALL LOW-VALUES BY SPACES.
           INSPECT M-SUBDPT-CI    REPLACING ALL LOW-VALUES BY SPACES.
           INSPECT M-EXPTYP-CI    REPLACING ALL LOW-VALUES BY SPACES.
           INSPECT M-EXPSUBTYP-CI REPLACING ALL LOW-VALUES BY SPACES.
           INSPECT M-MGRNM-XI     REPLACING ALL LOW-VALUES BY SPACES.
           INSPECT M-BADGE-CI     REPLACING ALL LOW-VALUES BY SPACES.
           INSPECT M-MGRUID-CI    REPLACING ALL LOW-VALUES BY SPACES.
           INSPECT M-CMNT-XI      REPLACING ALL LOW-VALUES BY SPACES.

           EJECT
       A330-SET-ATTRIBUTES-NORMAL.

           MOVE 'A330'      TO CA-PARAGRAPH-NBR.

           MOVE  ATTR-ALPHA-UNPROT-BRT-PEN-MDT  TO
                 M-FCSID-NA.

           MOVE  ATTR-ALPHA-UNPROT-MDT  TO
                 M-FCSID-XA
                 M-CMNT-XA
                 M-DPT-CA
                 M-SUBDPT-CA
                 M-EXPTYP-CA
                 M-EXPSUBTYP-CA
                 M-MGRUID-CA.

           MOVE  ATTR-ALPHA-PROT-MDT   TO
                 M-MKTCBU-CA
                 M-MKTCDIV-CA
                 M-MKTCRGN-CA
                 M-MKTCBU-XA
                 M-MKTCDIV-XA
                 M-MKTCRGN-XA
                 M-DPT-XA
                 M-EXPSUB-XA
                 M-MGRNM-XA
                 M-BADGE-CA
                 M-LASTUPD-DA
                 M-LASTUPD-XA
                 M-F-PRJ-NA
                 M-STD-AA
                 M-FYSTD-AA
                 M-ATD-AA
                 M-PATOT-AA.
           MOVE  ATTR-ALPHA-PROT-BRT-PEN-MDT   TO M-UID-CA
                                                  M-MAIN-MODEA
                                                  M-DATEA
                                                  M-TIMEA
                                                  M-CURRPD-DA.
           MOVE ATTR-ALPHA-PROT                TO
                                                  M-MSG-24A.

           PERFORM VARYING K FROM 1 BY 1
             UNTIL K > WS-TIME-BUCKETS
              MOVE ATTR-ALPHA-PROT-BRT-PEN-MDT  TO M-HDG1-XA (K)
              MOVE ATTR-ALPHA-PROT-BRT-PEN-MDT  TO M-HDG2-XA (K)
           END-PERFORM.

           IF  M-F-PRJ-NI > SPACES
               MOVE  ATTR-ALPHA-PROT-MDT   TO
                     M-DPT-CA
                     M-SUBDPT-CA
                     M-EXPTYP-CA
                     M-EXPSUBTYP-CA
      *BWM*          M-FCSID-XA
                     MOVE -1 TO M-FCSID-XL
      *BWM*          MOVE -1 TO M-MGRUID-CL
           END-IF.

           EJECT
       A335-SET-ATTR-PROMPT-FCST-ID.

           MOVE 'A335'      TO CA-PARAGRAPH-NBR.

           MOVE  ATTR-ALPHA-UNPROT-BRT-PEN-MDT  TO
                 M-FCSID-NA.

           MOVE  ATTR-ALPHA-PROT-MDT  TO
                 M-FCSID-XA
                 M-CMNT-XA
                 M-MKTCBU-CA
                 M-MKTCDIV-CA
                 M-MKTCRGN-CA
                 M-DPT-CA
                 M-SUBDPT-CA
                 M-EXPTYP-CA
                 M-EXPSUBTYP-CA
                 M-MKTCBU-XA
                 M-MKTCDIV-XA
                 M-MKTCRGN-XA
                 M-DPT-XA
                 M-EXPSUB-XA
                 M-MGRNM-XA
                 M-BADGE-CA
                 M-LASTUPD-DA
                 M-LASTUPD-XA
                 M-MGRUID-CA
                 M-F-PRJ-NA
                 M-STD-AA
                 M-FYSTD-AA
                 M-ATD-AA
                 M-PATOT-AA.

           MOVE ATTR-ALPHA-PROT-BRT-PEN-MDT    TO M-UID-CA
                                                  M-MAIN-MODEA
                                                  M-DATEA
                                                  M-TIMEA
                                                  M-CURRPD-DA.

           MOVE ATTR-ALPHA-PROT                TO
                                                  M-MSG-24A.

           PERFORM VARYING K FROM 1 BY 1
             UNTIL K > WS-TIME-BUCKETS
              MOVE ATTR-ALPHA-PROT-BRT-PEN-MDT  TO M-HDG1-XA (K)
              MOVE ATTR-ALPHA-PROT-BRT-PEN-MDT  TO M-HDG2-XA (K)
           END-PERFORM.

           PERFORM VARYING K FROM 1 BY 1
             UNTIL K > WS-TIME-BUCKETS
              MOVE ATTR-ALPHA-PROT-MDT  TO M-FCSP-AA (K)
           END-PERFORM.

           EJECT
       B000-PROCESS-ENTER-KEY.

           MOVE 'B000'      TO CA-PARAGRAPH-NBR.

           IF  NEW-FCST-ID
           AND M-FCSID-NI NOT = SPACES
               SET CA-UPDATE  TO TRUE
               PERFORM A250-RE-INIT-OUTPUT-VALUES
           ELSE
               EVALUATE TRUE
                   WHEN CA-ENTRY
                        PERFORM C000-VALIDATE-INPUT
                        IF  NO-ERRORS
                            MOVE -1             TO M-FCSID-XL
                            MOVE W9999-MSG-034  TO M-MSG-24I
                         END-IF
                   WHEN CA-UPDATE
                        PERFORM C000-VALIDATE-INPUT
                        IF  NO-ERRORS
                            MOVE -1             TO M-FCSID-XL
                            MOVE W9999-MSG-034  TO M-MSG-24I
                        END-IF
                   WHEN CA-DELETE
                        MOVE -1                 TO M-FCSID-NL
                        MOVE W9999-MSG-032      TO M-MSG-24I
                        SET ERRORS              TO TRUE
                   WHEN CA-PROMPT
                        PERFORM E025-PROMPT-FCST-ID
               END-EVALUATE
           END-IF.

           EJECT
       B600-SECURITY-CHECK.

           MOVE 'B600'      TO CA-PARAGRAPH-NBR.

           IF  CA-SYSTEM-ADMINISTRATOR
               SET SECURITY-OK    TO  TRUE
           ELSE
               MOVE CA-OP-RGN   TO F-MKTCRGN-C IN DCLTFSECPRD
               MOVE CA-OP-ID    TO A-UID-C     IN DCLTFSECPRD
               MOVE M-DPT-CI    TO F-DPT-C     IN DCLTFSECPRD

               EXEC SQL
                    SELECT A_SEQ_N
                      INTO :DCLTFSECPRD.A-SEQ-N
                      FROM D108.TFSECPRD
                     WHERE A_UID_C     = :DCLTFSECPRD.A-UID-C
                       AND F_MKTCRGN_C = :DCLTFSECPRD.F-MKTCRGN-C
                       AND F_DPT_C     = :DCLTFSECPRD.F-DPT-C
               END-EXEC

               SET MULTIPLE-ROWS TO TRUE
               PERFORM Z900-DB2-CHECK

               IF  DB2-NORMAL
               OR  DB2-MULTIPLE-ROWS
                   SET SECURITY-OK        TO TRUE
                   MOVE W9999-MSG-034     TO M-MSG-24I
               ELSE
                   SET SECURITY-NG        TO TRUE
               END-IF
           END-IF.

           EJECT
       C000-VALIDATE-INPUT.

           MOVE 'C000'      TO CA-PARAGRAPH-NBR.

           PERFORM C050-VALIDATE-RETR-HEADER

           IF  NO-ERRORS
               PERFORM C150-VALIDATE-AMOUNTS
           END-IF.

           EJECT
       C050-VALIDATE-RETR-HEADER.

           MOVE 'C050'      TO CA-PARAGRAPH-NBR.

           IF  NO-ERRORS
               IF  M-DPT-CI  > SPACES
                   PERFORM C130-VALIDATE-PRODUCT-LINE
               ELSE
                   SET ERRORS           TO TRUE
                   MOVE -1              TO M-DPT-CL
                   MOVE W9999-MSG-063   TO M-MSG-24I
               END-IF
           END-IF.

           IF  NO-ERRORS
               IF  M-MKTCBU-CI  > SPACES
                   PERFORM C115-VALIDATE-BU
               ELSE
                   SET ERRORS           TO TRUE
                   MOVE -1              TO M-MKTCBU-CL
                   MOVE W9999-MSG-008   TO M-MSG-24I
               END-IF
           END-IF.

           IF  NO-ERRORS
               IF  M-MKTCDIV-CI > SPACES
                   PERFORM C110-VALIDATE-DIVISION
               ELSE
                   SET ERRORS           TO TRUE
                   MOVE -1              TO M-MKTCDIV-CL
                   MOVE W9999-MSG-009   TO M-MSG-24I
               END-IF
           END-IF.

           IF  NO-ERRORS
               IF  M-MGRUID-CI  > SPACES
                   PERFORM C145-VALIDATE-MGRUID
               ELSE
                   SET ERRORS           TO TRUE
                   MOVE -1              TO M-EXPTYP-CL
                   MOVE W9999-MSG-030   TO  M-MSG-24I
               END-IF
           END-IF.

           IF  NO-ERRORS
               IF  M-EXPTYP-CI  > SPACES
                   PERFORM C140-VALIDATE-EXPTYP-EXPSUBTYP
               ELSE
                   SET ERRORS           TO TRUE
                   MOVE -1              TO M-EXPTYP-CL
                   MOVE W9999-MSG-013   TO M-MSG-24I
               END-IF
           END-IF.

           EJECT
       C060-GET-HEADER-INFO-ADD.

      *
      * < DO NOT SET ERRORS ON IN THIS PARAGRAPH (VS C050)
      *  IF INFO = SPACES ; IT IS NOT AN ERROR HERE     >
           MOVE 'C060'      TO CA-PARAGRAPH-NBR.
             IF M-DPT-CI     > SPACES
                   PERFORM C130-VALIDATE-PRODUCT-LINE
                   IF NO-ERRORS
                     MOVE F-DPT-X IN DCLTFPRODLN       TO  M-DPT-XI.
      *
             IF M-MKTCBU-CI  > SPACES
                    PERFORM C115-VALIDATE-BU
                    IF NO-ERRORS
                      MOVE  F-MKTCBU-X IN DCLTFBIZUNT   TO M-MKTCBU-XI.
      *
             IF  M-MKTCDIV-CI > SPACES
                 PERFORM C110-VALIDATE-DIVISION
                    IF NO-ERRORS
                    MOVE  F-MKTCDIV-X IN DCLTFDIV     TO M-MKTCDIV-XI.
      *
      *      IF M-MGRUID-CI  > SPACES
      *            PERFORM C145-VALIDATE-MGRUID
      *            IF NO-ERRORS
      *               MOVE A-UID-C   IN DCLTFSECACS     TO M-MGRUID-CI
      *               MOVE A-EMPNM-X IN DCLTFSECACS     TO M-MGRNM-XI
      *               MOVE A-BADGE-N IN DCLTFSECACS     TO M-BADGE-CI.
      *
             IF M-EXPTYP-CI  > SPACES
                   PERFORM C140-VALIDATE-EXPTYP-EXPSUBTYP
                   IF NO-ERRORS
                     MOVE F-EXPTYP-X    IN DCLTFEXPTYP TO M-EXPSUB-XI.

           EJECT
       C070-MOVE-HEADER-INFO-RETR.

           MOVE 'C070'      TO CA-PARAGRAPH-NBR.

           MOVE A-UID-C     IN DCLTFFCSHDR   TO M-MGRUID-CI
           MOVE F-FCSID-N   IN DCLTFFCSHDR   TO M-FCSID-NI
           MOVE F-FCSID-X   IN DCLTFFCSHDR   TO M-FCSID-XI
           MOVE F-CMNT-X    IN DCLTFFCSHDR   TO M-CMNT-XI
           MOVE F-MKTCDIV-C IN DCLTFFCSHDR   TO M-MKTCDIV-CI
           MOVE F-MKTCRGN-C IN DCLTFFCSHDR   TO M-MKTCRGN-CI
           MOVE F-DPT-C     IN DCLTFFCSHDR   TO M-DPT-CI
           MOVE F-SUBDPT-C  IN DCLTFFCSHDR   TO M-SUBDPT-CI
           MOVE F-EXPTYP-C  IN DCLTFFCSHDR   TO M-EXPTYP-CI
           MOVE F-EXPSUBTYP-C IN DCLTFFCSHDR TO M-EXPSUBTYP-CI.
           MOVE F-EXPSUBTYP-C IN DCLTFFCSHDR TO M-EXPSUBTYP-CI.

           PERFORM C050-VALIDATE-RETR-HEADER.

           EJECT
       C080-MOVE-AMOUNT-INFO-RETR.

           MOVE 'C080'      TO CA-PARAGRAPH-NBR.

           IF  CA-FISCAL-PERIOD = NSC-FISCAL-PERIOD
               EVALUATE CA-FISCAL-PERIOD
                   WHEN 01
                        COMPUTE W0001-FCSP-AI  (01) =
                              ( CA-P-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (02) =
                              ( CA-S-FCSP00-A )
                        COMPUTE W0001-FCSP-AI  (03) =
                              ( CA-S-FCSP01-A )
                        COMPUTE W0001-FCSP-AI  (04) =
                              ( CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (05) =
                              ( CA-S-FCSP00-A
                              + CA-S-FCSP01-A
                              + CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (06) =
                              ( CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (07) =
                              ( CA-S-FCSQ02-A )
                        COMPUTE W0001-FCSP-AI  (08) =
                              ( CA-S-FCSQ03-A )
                        COMPUTE W0001-FCSP-AI  (09) =
                              ( CA-S-FCSP00-A
                              + CA-S-FCSP01-A
                              + CA-S-FCSP02-A
                              + CA-S-FCSP03-A
                              + CA-S-FCSP04-A
                              + CA-S-FCSP05-A
                              + CA-S-FCSQ02-A
                              + CA-S-FCSQ03-A )
                        COMPUTE W0001-FCSP-AI  (10) =
                              ( 0 )
                        COMPUTE W0001-FCSP-AI  (11) =
                              ( 0 )
                   WHEN 02
                        COMPUTE W0001-FCSP-AI  (01) =
                              ( CA-P-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (02) =
                              ( CA-P-ACTP02-A )
                        COMPUTE W0001-FCSP-AI  (03) =
                              ( CA-S-FCSP01-A )
                        COMPUTE W0001-FCSP-AI  (04) =
                              ( CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (05) =
                              ( CA-P-ACTP01-A
                              + CA-S-FCSP01-A
                              + CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (06) =
                              ( CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (07) =
                              ( CA-S-FCSQ02-A )
                        COMPUTE W0001-FCSP-AI  (08) =
                              ( CA-S-FCSQ03-A )
                        COMPUTE W0001-FCSP-AI  (09) =
                              ( CA-P-ACTP01-A
                              + CA-S-FCSP01-A
                              + CA-S-FCSP02-A
                              + CA-S-FCSP03-A
                              + CA-S-FCSP04-A
                              + CA-S-FCSP05-A
                              + CA-S-FCSQ02-A
                              + CA-S-FCSQ03-A )
                        COMPUTE W0001-FCSP-AI  (10) =
                              ( 0 )
                        COMPUTE W0001-FCSP-AI  (11) =
                              ( 0 )
                   WHEN 03
                        COMPUTE W0001-FCSP-AI  (01) =
                              ( CA-P-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (02) =
                              ( CA-P-ACTP02-A )
                        COMPUTE W0001-FCSP-AI  (03) =
                              ( CA-P-ACTP03-A )
                        COMPUTE W0001-FCSP-AI  (04) =
                              ( CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (05) =
                              ( CA-P-ACTP01-A
                              + CA-P-ACTP02-A
                              + CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (06) =
                              ( CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (07) =
                              ( CA-S-FCSP04-A )
                        COMPUTE W0001-FCSP-AI  (08) =
                              ( CA-S-FCSP05-A )
                        COMPUTE W0001-FCSP-AI  (09) =
                              ( CA-S-FCSQ02-A )
                        COMPUTE W0001-FCSP-AI  (10) =
                              ( CA-S-FCSQ03-A )
                        COMPUTE W0001-FCSP-AI  (11) =
                              ( CA-P-ACTP01-A
                              + CA-P-ACTP02-A
                              + CA-S-FCSP02-A
                              + CA-S-FCSP03-A
                              + CA-S-FCSP04-A
                              + CA-S-FCSP05-A
                              + CA-S-FCSQ02-A
                              + CA-S-FCSQ03-A )
                   WHEN 04
                        COMPUTE W0001-FCSP-AI  (01) =
                              ( CA-P-ACTQ01-A )
                        COMPUTE W0001-FCSP-AI  (02) =
                              ( CA-P-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (03) =
                              ( CA-S-FCSP00-A )
                        COMPUTE W0001-FCSP-AI  (04) =
                              ( CA-S-FCSP01-A )
                        COMPUTE W0001-FCSP-AI  (05) =
                              ( CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (06) =
                              ( CA-S-FCSP00-A
                              + CA-S-FCSP01-A
                              + CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (07) =
                              ( CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (08) =
                              ( CA-S-FCSQ02-A )
                        COMPUTE W0001-FCSP-AI  (09) =
                              ( CA-P-ACTQ01-A
                              + CA-S-FCSP00-A
                              + CA-S-FCSP01-A
                              + CA-S-FCSP02-A
                              + CA-S-FCSP03-A
                              + CA-S-FCSP04-A
                              + CA-S-FCSP05-A
                              + CA-S-FCSQ02-A )
                        COMPUTE W0001-FCSP-AI  (10) =
                              ( 0 )
                        COMPUTE W0001-FCSP-AI  (11) =
                              ( 0 )
                   WHEN 05
                        COMPUTE W0001-FCSP-AI  (01) =
                              ( CA-P-ACTQ01-A )
                        COMPUTE W0001-FCSP-AI  (02) =
                              ( CA-P-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (03) =
                              ( CA-P-ACTP02-A )
                        COMPUTE W0001-FCSP-AI  (04) =
                              ( CA-S-FCSP01-A )
                        COMPUTE W0001-FCSP-AI  (05) =
                              ( CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (06) =
                              ( CA-S-FCSP00-A
                              + CA-S-FCSP01-A
                              + CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (07) =
                              ( CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (08) =
                              ( CA-S-FCSQ02-A )
                        COMPUTE W0001-FCSP-AI  (09) =
                              ( CA-P-ACTQ01-A
                              + CA-P-ACTP01-A
                              + CA-S-FCSP01-A
                              + CA-S-FCSP02-A
                              + CA-S-FCSP03-A
                              + CA-S-FCSP04-A
                              + CA-S-FCSP05-A
                              + CA-S-FCSQ02-A )
                        COMPUTE W0001-FCSP-AI  (10) =
                              ( 0 )
                        COMPUTE W0001-FCSP-AI  (11) =
                              ( 0 )
                   WHEN 06
                        COMPUTE W0001-FCSP-AI  (01) =
                              ( CA-P-ACTQ01-A )
                        COMPUTE W0001-FCSP-AI  (02) =
                              ( CA-P-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (03) =
                              ( CA-P-ACTP02-A )
                        COMPUTE W0001-FCSP-AI  (04) =
                              ( CA-P-ACTP03-A )
                        COMPUTE W0001-FCSP-AI  (05) =
                              ( CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (06) =
                              ( CA-P-ACTP01-A
                              + CA-P-ACTP02-A
                              + CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (07) =
                              ( CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (08) =
                              ( CA-S-FCSP04-A )
                        COMPUTE W0001-FCSP-AI  (09) =
                              ( CA-S-FCSP05-A )
                        COMPUTE W0001-FCSP-AI  (10) =
                              ( CA-S-FCSQ02-A )
                        COMPUTE W0001-FCSP-AI  (11) =
                              ( CA-P-ACTQ01-A
                              + CA-P-ACTP01-A
                              + CA-P-ACTP02-A
                              + CA-S-FCSP02-A
                              + CA-S-FCSP03-A
                              + CA-S-FCSP04-A
                              + CA-S-FCSP05-A
                              + CA-S-FCSQ02-A )
                   WHEN 07
                        COMPUTE W0001-FCSP-AI  (01) =
                              ( CA-H-ACTP06-A
                              + CA-H-ACTP05-A
                              + CA-H-ACTP04-A )
                        COMPUTE W0001-FCSP-AI  (02) =
                              ( CA-H-ACTP03-A
                              + CA-H-ACTP02-A
                              + CA-H-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (03) =
                              ( CA-P-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (04) =
                              ( CA-S-FCSP00-A )
                        COMPUTE W0001-FCSP-AI  (05) =
                              ( CA-S-FCSP01-A )
                        COMPUTE W0001-FCSP-AI  (06) =
                              ( CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (07) =
                              ( CA-S-FCSP00-A
                              + CA-S-FCSP01-A
                              + CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (08) =
                              ( CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (09) =
                              ( CA-H-ACTP06-A
                              + CA-H-ACTP05-A
                              + CA-H-ACTP04-A
                              + CA-H-ACTP03-A
                              + CA-H-ACTP02-A
                              + CA-H-ACTP01-A
                              + CA-S-FCSP00-A
                              + CA-S-FCSP01-A
                              + CA-S-FCSP02-A
                              + CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (10) =
                              ( 0 )
                        COMPUTE W0001-FCSP-AI  (11) =
                              ( 0 )
                   WHEN 08
                        COMPUTE W0001-FCSP-AI  (01) =
                              ( CA-H-ACTP06-A
                              + CA-H-ACTP05-A
                              + CA-H-ACTP04-A )
                        COMPUTE W0001-FCSP-AI  (02) =
                              ( CA-H-ACTP03-A
                              + CA-H-ACTP02-A
                              + CA-H-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (03) =
                              ( CA-P-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (04) =
                              ( CA-P-ACTP02-A )
                        COMPUTE W0001-FCSP-AI  (05) =
                              ( CA-S-FCSP01-A )
                        COMPUTE W0001-FCSP-AI  (06) =
                              ( CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (07) =
                              ( CA-P-ACTP01-A
                              + CA-S-FCSP01-A
                              + CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (08) =
                              ( CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (09) =
                              ( CA-H-ACTP06-A
                              + CA-H-ACTP05-A
                              + CA-H-ACTP04-A
                              + CA-H-ACTP03-A
                              + CA-H-ACTP02-A
                              + CA-H-ACTP01-A
                              + CA-P-ACTP01-A
                              + CA-S-FCSP01-A
                              + CA-S-FCSP02-A
                              + CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (10) =
                              ( 0 )
                        COMPUTE W0001-FCSP-AI  (11) =
                              ( 0 )
                   WHEN 09
                        COMPUTE W0001-FCSP-AI  (01) =
                              ( CA-H-ACTP06-A
                              + CA-H-ACTP05-A
                              + CA-H-ACTP04-A )
                        COMPUTE W0001-FCSP-AI  (02) =
                              ( CA-H-ACTP03-A
                              + CA-H-ACTP02-A
                              + CA-H-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (03) =
                              ( CA-P-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (04) =
                              ( CA-P-ACTP02-A )
                        COMPUTE W0001-FCSP-AI  (05) =
                              ( CA-P-ACTP03-A )
                        COMPUTE W0001-FCSP-AI  (06) =
                              ( CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (07) =
                              ( CA-P-ACTP01-A
                              + CA-P-ACTP02-A
                              + CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (08) =
                              ( CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (09) =
                              ( CA-S-FCSP04-A )
                        COMPUTE W0001-FCSP-AI  (10) =
                              ( CA-S-FCSP05-A )
                        COMPUTE W0001-FCSP-AI  (11) =
                              ( CA-H-ACTP06-A
                              + CA-H-ACTP05-A
                              + CA-H-ACTP04-A
                              + CA-H-ACTP03-A
                              + CA-H-ACTP02-A
                              + CA-H-ACTP01-A
                              + CA-P-ACTP01-A
                              + CA-P-ACTP02-A
                              + CA-S-FCSP02-A
                              + CA-S-FCSP03-A
                              + CA-S-FCSP04-A
                              + CA-S-FCSP05-A )
                   WHEN 10
                        COMPUTE W0001-FCSP-AI  (01) =
                              ( CA-H-ACTP09-A
                              + CA-H-ACTP08-A
                              + CA-H-ACTP07-A )
                        COMPUTE W0001-FCSP-AI  (02) =
                              ( CA-H-ACTP06-A
                              + CA-H-ACTP05-A
                              + CA-H-ACTP04-A )
                        COMPUTE W0001-FCSP-AI  (03) =
                              ( CA-H-ACTP03-A
                              + CA-H-ACTP02-A
                              + CA-H-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (04) =
                              ( CA-P-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (05) =
                              ( CA-S-FCSP00-A )
                        COMPUTE W0001-FCSP-AI  (06) =
                              ( CA-S-FCSP01-A )
                        COMPUTE W0001-FCSP-AI  (07) =
                              ( CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (08) =
                              ( CA-S-FCSP00-A
                              + CA-S-FCSP01-A
                              + CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (09) =
                              ( CA-H-ACTP09-A
                              + CA-H-ACTP08-A
                              + CA-H-ACTP07-A
                              + CA-H-ACTP06-A
                              + CA-H-ACTP05-A
                              + CA-H-ACTP04-A
                              + CA-H-ACTP03-A
                              + CA-H-ACTP02-A
                              + CA-H-ACTP01-A
                              + CA-S-FCSP00-A
                              + CA-S-FCSP01-A
                              + CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (10) =
                              ( CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (11) =
                              ( 0 )
                   WHEN 11
                        COMPUTE W0001-FCSP-AI  (01) =
                              ( CA-H-ACTP09-A
                              + CA-H-ACTP08-A
                              + CA-H-ACTP07-A )
                        COMPUTE W0001-FCSP-AI  (02) =
                              ( CA-H-ACTP06-A
                              + CA-H-ACTP05-A
                              + CA-H-ACTP04-A )
                        COMPUTE W0001-FCSP-AI  (03) =
                              ( CA-H-ACTP03-A
                              + CA-H-ACTP02-A
                              + CA-H-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (04) =
                              ( CA-P-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (05) =
                              ( CA-P-ACTP02-A )
                        COMPUTE W0001-FCSP-AI  (06) =
                              ( CA-S-FCSP01-A )
                        COMPUTE W0001-FCSP-AI  (07) =
                              ( CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (08) =
                              ( CA-P-ACTP01-A
                              + CA-S-FCSP01-A
                              + CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (09) =
                              ( CA-H-ACTP09-A
                              + CA-H-ACTP08-A
                              + CA-H-ACTP07-A
                              + CA-H-ACTP06-A
                              + CA-H-ACTP05-A
                              + CA-H-ACTP04-A
                              + CA-H-ACTP03-A
                              + CA-H-ACTP02-A
                              + CA-H-ACTP01-A
                              + CA-P-ACTP01-A
                              + CA-S-FCSP01-A
                              + CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (10) =
                              ( CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (11) =
                              ( 0 )
                   WHEN 12
                        COMPUTE W0001-FCSP-AI  (01) =
                              ( CA-H-ACTP09-A
                              + CA-H-ACTP08-A
                              + CA-H-ACTP07-A
                              + CA-H-ACTP06-A
                              + CA-H-ACTP05-A
                              + CA-H-ACTP04-A )
                        COMPUTE W0001-FCSP-AI  (02) =
                              ( CA-H-ACTP03-A
                              + CA-H-ACTP02-A
                              + CA-H-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (03) =
                              ( CA-P-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (04) =
                              ( CA-P-ACTP02-A )
                        COMPUTE W0001-FCSP-AI  (05) =
                              ( CA-P-ACTP03-A )
                        COMPUTE W0001-FCSP-AI  (06) =
                              ( CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (07) =
                              ( CA-P-ACTP01-A
                              + CA-P-ACTP02-A
                              + CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (08) =
                              ( CA-H-ACTP09-A
                              + CA-H-ACTP08-A
                              + CA-H-ACTP07-A
                              + CA-H-ACTP06-A
                              + CA-H-ACTP05-A
                              + CA-H-ACTP04-A
                              + CA-H-ACTP03-A
                              + CA-H-ACTP02-A
                              + CA-H-ACTP01-A
                              + CA-P-ACTP01-A
                              + CA-P-ACTP02-A
                              + CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (09) =
                              ( CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (10) =
                              ( CA-S-FCSP04-A )
                        COMPUTE W0001-FCSP-AI  (11) =
                              ( CA-S-FCSP05-A )
               END-EVALUATE
           ELSE
               EVALUATE CA-FISCAL-PERIOD
                   WHEN 01
                        COMPUTE W0001-FCSP-AI  (01) =
                              ( CA-P-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (02) =
                              ( CA-S-FCSP00-A )
                        COMPUTE W0001-FCSP-AI  (03) =
                              ( CA-S-FCSP01-A )
                        COMPUTE W0001-FCSP-AI  (04) =
                              ( CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (05) =
                              ( CA-P-ACTP01-A
                              + CA-S-FCSP01-A
                              + CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (06) =
                              ( CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (07) =
                              ( CA-S-FCSQ02-A )
                        COMPUTE W0001-FCSP-AI  (08) =
                              ( CA-S-FCSQ03-A )
                        COMPUTE W0001-FCSP-AI  (09) =
                              ( CA-P-ACTP01-A
                              + CA-S-FCSP01-A
                              + CA-S-FCSP02-A
                              + CA-S-FCSP03-A
                              + CA-S-FCSP04-A
                              + CA-S-FCSP05-A
                              + CA-S-FCSQ02-A
                              + CA-S-FCSQ03-A )
                        COMPUTE W0001-FCSP-AI  (10) =
                              ( 0 )
                        COMPUTE W0001-FCSP-AI  (11) =
                              ( 0 )
                   WHEN 02
                        COMPUTE W0001-FCSP-AI  (01) =
                              ( CA-P-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (02) =
                              ( CA-P-ACTP02-A )
                        COMPUTE W0001-FCSP-AI  (03) =
                              ( CA-S-FCSP01-A )
                        COMPUTE W0001-FCSP-AI  (04) =
                              ( CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (05) =
                              ( CA-P-ACTP01-A
                              + CA-P-ACTP02-A
                              + CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (06) =
                              ( CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (07) =
                              ( CA-S-FCSQ02-A )
                        COMPUTE W0001-FCSP-AI  (08) =
                              ( CA-S-FCSQ03-A )
                        COMPUTE W0001-FCSP-AI  (09) =
                              ( CA-P-ACTP01-A
                              + CA-P-ACTP02-A
                              + CA-S-FCSP02-A
                              + CA-S-FCSP03-A
                              + CA-S-FCSP04-A
                              + CA-S-FCSP05-A
                              + CA-S-FCSQ02-A
                              + CA-S-FCSQ03-A )
                        COMPUTE W0001-FCSP-AI  (10) =
                              ( 0 )
                        COMPUTE W0001-FCSP-AI  (11) =
                              ( 0 )
                   WHEN 03
                        COMPUTE W0001-FCSP-AI  (01) =
                              ( CA-P-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (02) =
                              ( CA-P-ACTP02-A )
                        COMPUTE W0001-FCSP-AI  (03) =
                              ( CA-P-ACTP03-A )
                        COMPUTE W0001-FCSP-AI  (04) =
                              ( CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (05) =
                              ( CA-P-ACTP01-A
                              + CA-P-ACTP02-A
                              + CA-P-ACTP03-A )
                        COMPUTE W0001-FCSP-AI  (06) =
                              ( CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (07) =
                              ( CA-S-FCSP04-A )
                        COMPUTE W0001-FCSP-AI  (08) =
                              ( CA-S-FCSP05-A )
                        COMPUTE W0001-FCSP-AI  (09) =
                              ( CA-S-FCSQ02-A )
                        COMPUTE W0001-FCSP-AI  (10) =
                              ( CA-S-FCSQ03-A )
                        COMPUTE W0001-FCSP-AI  (11) =
                              ( CA-P-ACTP01-A
                              + CA-P-ACTP02-A
                              + CA-P-ACTP03-A
                              + CA-S-FCSP03-A
                              + CA-S-FCSP04-A
                              + CA-S-FCSP05-A
                              + CA-S-FCSQ02-A
                              + CA-S-FCSQ03-A )
                   WHEN 04
                        COMPUTE W0001-FCSP-AI  (01) =
                              ( CA-P-ACTQ01-A )
                        COMPUTE W0001-FCSP-AI  (02) =
                              ( CA-P-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (03) =
                              ( CA-S-FCSP00-A )
                        COMPUTE W0001-FCSP-AI  (04) =
                              ( CA-S-FCSP01-A )
                        COMPUTE W0001-FCSP-AI  (05) =
                              ( CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (06) =
                              ( CA-P-ACTP01-A
                              + CA-S-FCSP01-A
                              + CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (07) =
                              ( CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (08) =
                              ( CA-S-FCSQ02-A )
                        COMPUTE W0001-FCSP-AI  (09) =
                              ( CA-P-ACTQ01-A
                              + CA-P-ACTP01-A
                              + CA-S-FCSP01-A
                              + CA-S-FCSP02-A
                              + CA-S-FCSP03-A
                              + CA-S-FCSP04-A
                              + CA-S-FCSP05-A
                              + CA-S-FCSQ02-A )
                        COMPUTE W0001-FCSP-AI  (10) =
                              ( 0 )
                        COMPUTE W0001-FCSP-AI  (11) =
                              ( 0 )
                   WHEN 05
                        COMPUTE W0001-FCSP-AI  (01) =
                              ( CA-P-ACTQ01-A )
                        COMPUTE W0001-FCSP-AI  (02) =
                              ( CA-P-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (03) =
                              ( CA-P-ACTP02-A )
                        COMPUTE W0001-FCSP-AI  (04) =
                              ( CA-S-FCSP01-A )
                        COMPUTE W0001-FCSP-AI  (05) =
                              ( CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (06) =
                              ( CA-P-ACTP01-A
                              + CA-S-FCSP01-A
                              + CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (07) =
                              ( CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (08) =
                              ( CA-S-FCSQ02-A )
                        COMPUTE W0001-FCSP-AI  (09) =
                              ( CA-P-ACTQ01-A
                              + CA-P-ACTP01-A
                              + CA-P-ACTP02-A
                              + CA-S-FCSP02-A
                              + CA-S-FCSP03-A
                              + CA-S-FCSP04-A
                              + CA-S-FCSP05-A
                              + CA-S-FCSQ02-A )
                        COMPUTE W0001-FCSP-AI  (10) =
                              ( 0 )
                        COMPUTE W0001-FCSP-AI  (11) =
                              ( 0 )
                   WHEN 06
                        COMPUTE W0001-FCSP-AI  (01) =
                              ( CA-P-ACTQ01-A )
                        COMPUTE W0001-FCSP-AI  (02) =
                              ( CA-P-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (03) =
                              ( CA-P-ACTP02-A )
                        COMPUTE W0001-FCSP-AI  (04) =
                              ( CA-P-ACTP03-A )
                        COMPUTE W0001-FCSP-AI  (05) =
                              ( CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (06) =
                              ( CA-P-ACTP01-A
                              + CA-P-ACTP02-A
                              + CA-P-ACTP03-A )
                        COMPUTE W0001-FCSP-AI  (07) =
                              ( CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (08) =
                              ( CA-S-FCSP04-A )
                        COMPUTE W0001-FCSP-AI  (09) =
                              ( CA-S-FCSP05-A )
                        COMPUTE W0001-FCSP-AI  (10) =
                              ( CA-S-FCSQ02-A )
                        COMPUTE W0001-FCSP-AI  (11) =
                              ( CA-P-ACTQ01-A
                              + CA-P-ACTP01-A
                              + CA-P-ACTP02-A
                              + CA-P-ACTP03-A
                              + CA-S-FCSP03-A
                              + CA-S-FCSP04-A
                              + CA-S-FCSP05-A
                              + CA-S-FCSQ02-A )
                   WHEN 07
                        COMPUTE W0001-FCSP-AI  (01) =
                              ( CA-H-ACTP06-A
                              + CA-H-ACTP05-A
                              + CA-H-ACTP04-A )
                        COMPUTE W0001-FCSP-AI  (02) =
                              ( CA-H-ACTP03-A
                              + CA-H-ACTP02-A
                              + CA-H-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (03) =
                              ( CA-P-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (04) =
                              ( CA-S-FCSP00-A )
                        COMPUTE W0001-FCSP-AI  (05) =
                              ( CA-S-FCSP01-A )
                        COMPUTE W0001-FCSP-AI  (06) =
                              ( CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (07) =
                              ( CA-P-ACTP01-A
                              + CA-S-FCSP01-A
                              + CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (08) =
                              ( CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (09) =
                              ( CA-H-ACTP06-A
                              + CA-H-ACTP05-A
                              + CA-H-ACTP04-A
                              + CA-H-ACTP03-A
                              + CA-H-ACTP02-A
                              + CA-H-ACTP01-A
                              + CA-P-ACTP01-A
                              + CA-S-FCSP01-A
                              + CA-S-FCSP02-A
                              + CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (10) =
                              ( 0 )
                        COMPUTE W0001-FCSP-AI  (11) =
                              ( 0 )
                   WHEN 08
                        COMPUTE W0001-FCSP-AI  (01) =
                              ( CA-H-ACTP06-A
                              + CA-H-ACTP05-A
                              + CA-H-ACTP04-A )
                        COMPUTE W0001-FCSP-AI  (02) =
                              ( CA-H-ACTP03-A
                              + CA-H-ACTP02-A
                              + CA-H-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (03) =
                              ( CA-P-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (04) =
                              ( CA-P-ACTP02-A )
                        COMPUTE W0001-FCSP-AI  (05) =
                              ( CA-S-FCSP01-A )
                        COMPUTE W0001-FCSP-AI  (06) =
                              ( CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (07) =
                              ( CA-P-ACTP01-A
                              + CA-P-ACTP02-A
                              + CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (08) =
                              ( CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (09) =
                              ( CA-H-ACTP06-A
                              + CA-H-ACTP05-A
                              + CA-H-ACTP04-A
                              + CA-H-ACTP03-A
                              + CA-H-ACTP02-A
                              + CA-H-ACTP01-A
                              + CA-P-ACTP01-A
                              + CA-P-ACTP02-A
                              + CA-S-FCSP02-A
                              + CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (10) =
                              ( 0 )
                        COMPUTE W0001-FCSP-AI  (11) =
                              ( 0 )
                   WHEN 09
                        COMPUTE W0001-FCSP-AI  (01) =
                              ( CA-H-ACTP06-A
                              + CA-H-ACTP05-A
                              + CA-H-ACTP04-A )
                        COMPUTE W0001-FCSP-AI  (02) =
                              ( CA-H-ACTP03-A
                              + CA-H-ACTP02-A
                              + CA-H-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (03) =
                              ( CA-P-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (04) =
                              ( CA-P-ACTP02-A )
                        COMPUTE W0001-FCSP-AI  (05) =
                              ( CA-P-ACTP03-A )
                        COMPUTE W0001-FCSP-AI  (06) =
                              ( CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (07) =
                              ( CA-P-ACTP01-A
                              + CA-P-ACTP02-A
                              + CA-P-ACTP03-A )
                        COMPUTE W0001-FCSP-AI  (08) =
                              ( CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (09) =
                              ( CA-S-FCSP04-A )
                        COMPUTE W0001-FCSP-AI  (10) =
                              ( CA-S-FCSP05-A )
                        COMPUTE W0001-FCSP-AI  (11) =
                              ( CA-H-ACTP06-A
                              + CA-H-ACTP05-A
                              + CA-H-ACTP04-A
                              + CA-H-ACTP03-A
                              + CA-H-ACTP02-A
                              + CA-H-ACTP01-A
                              + CA-P-ACTP01-A
                              + CA-P-ACTP02-A
                              + CA-P-ACTP03-A
                              + CA-S-FCSP03-A
                              + CA-S-FCSP04-A
                              + CA-S-FCSP05-A )
                   WHEN 10
                        COMPUTE W0001-FCSP-AI  (01) =
                              ( CA-H-ACTP09-A
                              + CA-H-ACTP08-A
                              + CA-H-ACTP07-A )
                        COMPUTE W0001-FCSP-AI  (02) =
                              ( CA-H-ACTP06-A
                              + CA-H-ACTP05-A
                              + CA-H-ACTP04-A )
                        COMPUTE W0001-FCSP-AI  (03) =
                              ( CA-H-ACTP03-A
                              + CA-H-ACTP02-A
                              + CA-H-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (04) =
                              ( CA-P-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (05) =
                              ( CA-S-FCSP00-A )
                        COMPUTE W0001-FCSP-AI  (06) =
                              ( CA-S-FCSP01-A )
                        COMPUTE W0001-FCSP-AI  (07) =
                              ( CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (08) =
                              ( CA-P-ACTP01-A
                              + CA-S-FCSP01-A
                              + CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (09) =
                              ( CA-H-ACTP09-A
                              + CA-H-ACTP08-A
                              + CA-H-ACTP07-A
                              + CA-H-ACTP06-A
                              + CA-H-ACTP05-A
                              + CA-H-ACTP04-A
                              + CA-H-ACTP03-A
                              + CA-H-ACTP02-A
                              + CA-H-ACTP01-A
                              + CA-P-ACTP01-A
                              + CA-S-FCSP01-A
                              + CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (10) =
                              ( CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (11) =
                              ( 0 )
                   WHEN 11
                        COMPUTE W0001-FCSP-AI  (01) =
                              ( CA-H-ACTP09-A
                              + CA-H-ACTP08-A
                              + CA-H-ACTP07-A )
                        COMPUTE W0001-FCSP-AI  (02) =
                              ( CA-H-ACTP06-A
                              + CA-H-ACTP05-A
                              + CA-H-ACTP04-A )
                        COMPUTE W0001-FCSP-AI  (03) =
                              ( CA-H-ACTP03-A
                              + CA-H-ACTP02-A
                              + CA-H-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (04) =
                              ( CA-P-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (05) =
                              ( CA-P-ACTP02-A )
                        COMPUTE W0001-FCSP-AI  (06) =
                              ( CA-S-FCSP01-A )
                        COMPUTE W0001-FCSP-AI  (07) =
                              ( CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (08) =
                              ( CA-P-ACTP01-A
                              + CA-P-ACTP02-A
                              + CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (09) =
                              ( CA-H-ACTP09-A
                              + CA-H-ACTP08-A
                              + CA-H-ACTP07-A
                              + CA-H-ACTP06-A
                              + CA-H-ACTP05-A
                              + CA-H-ACTP04-A
                              + CA-H-ACTP03-A
                              + CA-H-ACTP02-A
                              + CA-H-ACTP01-A
                              + CA-P-ACTP01-A
                              + CA-P-ACTP02-A
                              + CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (10) =
                              ( CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (11) =
                              ( 0 )
                   WHEN 12
                        COMPUTE W0001-FCSP-AI  (01) =
                              ( CA-H-ACTP09-A
                              + CA-H-ACTP08-A
                              + CA-H-ACTP07-A
                              + CA-H-ACTP06-A
                              + CA-H-ACTP05-A
                              + CA-H-ACTP04-A )
                        COMPUTE W0001-FCSP-AI  (02) =
                              ( CA-H-ACTP03-A
                              + CA-H-ACTP02-A
                              + CA-H-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (03) =
                              ( CA-P-ACTP01-A )
                        COMPUTE W0001-FCSP-AI  (04) =
                              ( CA-P-ACTP02-A )
                        COMPUTE W0001-FCSP-AI  (05) =
                              ( CA-P-ACTP03-A )
                        COMPUTE W0001-FCSP-AI  (06) =
                              ( CA-S-FCSP02-A )
                        COMPUTE W0001-FCSP-AI  (07) =
                              ( CA-P-ACTP01-A
                              + CA-P-ACTP02-A
                              + CA-P-ACTP03-A )
                        COMPUTE W0001-FCSP-AI  (08) =
                              ( CA-H-ACTP09-A
                              + CA-H-ACTP08-A
                              + CA-H-ACTP07-A
                              + CA-H-ACTP06-A
                              + CA-H-ACTP05-A
                              + CA-H-ACTP04-A
                              + CA-H-ACTP03-A
                              + CA-H-ACTP02-A
                              + CA-H-ACTP01-A
                              + CA-P-ACTP01-A
                              + CA-P-ACTP02-A
                              + CA-P-ACTP03-A )
                        COMPUTE W0001-FCSP-AI  (09) =
                              ( CA-S-FCSP03-A )
                        COMPUTE W0001-FCSP-AI  (10) =
                              ( CA-S-FCSP04-A )
                        COMPUTE W0001-FCSP-AI  (11) =
                              ( CA-S-FCSP05-A )
               END-EVALUATE
           END-IF.


           IF  TFPRJHDR-OK
               MOVE F-PRJ-N   IN DCLTFPRJHDR  TO M-F-PRJ-NI
               MOVE P-TOT-A   IN DCLTFPRJHDR  TO W0001-PATOT-AI
               MOVE P-ACT-A   IN DCLTFPRJHDR  TO W0001-STD-AI
               MOVE P-ACCR-A  IN DCLTFPRJHDR  TO W0001-ATD-AI
               MOVE W0001-ATD-AI              TO W0001-ATD-AI-D
               MOVE W0001-ATD-AI-D            TO M-ATD-AI
               MOVE W0001-STD-AI              TO W0001-STD-AI-D
               MOVE W0001-STD-AI-D            TO M-STD-AI
               COMPUTE W0001-YTD-AI =
                    (( CA-P-ACTP01-R
                     + CA-P-ACTP02-R
                     + CA-P-ACTP03-R
                     + CA-P-ACTQ01-R
                     + CA-P-ACTH01-R
                     + 500 )
                     / 1000 )
               MOVE W0001-YTD-AI      TO W0001-YTD-AI-D
               MOVE W0001-YTD-AI-D    TO M-FYSTD-AI
               MOVE W0001-PATOT-AI    TO W0001-PATOT-AI-D
               MOVE W0001-PATOT-AI-D  TO M-PATOT-AI
           ELSE
               MOVE SPACES            TO M-F-PRJ-NI
               MOVE ZEROES            TO W0001-PATOT-AI
               MOVE ZEROES            TO W0001-STD-AI
               MOVE ZEROES            TO W0001-YTD-AI
               MOVE ZEROES            TO W0001-ATD-AI
               MOVE W0001-ATD-AI      TO W0001-ATD-AI-D
               MOVE W0001-ATD-AI-D    TO M-ATD-AI
               MOVE W0001-STD-AI      TO W0001-STD-AI-D
               MOVE W0001-STD-AI-D    TO M-STD-AI
               MOVE W0001-YTD-AI      TO W0001-YTD-AI-D
               MOVE W0001-YTD-AI-D    TO M-FYSTD-AI
               MOVE W0001-PATOT-AI    TO W0001-PATOT-AI-D
               MOVE W0001-PATOT-AI-D  TO M-PATOT-AI
           END-IF.

           PERFORM VARYING K FROM 1 BY 1
             UNTIL K > WS-TIME-BUCKETS
              MOVE W0001-FCSP-AI   (K)  TO W0001-FCSP-AI-D51
              MOVE W0001-FCSP-AI-D41    TO M-FCSP-AI (K)
           END-PERFORM.

           EJECT
       C100-VALIDATE-FCST-ID.

           MOVE 'C100'      TO CA-PARAGRAPH-NBR.

           IF  M-FCSID-NI = SPACE OR LOW-VALUES OR ZERO
               NEXT SENTENCE
           ELSE
               MOVE M-FCSID-NI  TO CON-ALPHA-INPUT-FIELD
               MOVE 'D'         TO CON-FIELD-TYPE
               PERFORM B900-CONVERT-NUMERIC
                  THRU B999-CONVERT-END
               IF  CON-OK
                   MOVE CON-NUMERIC-DECIMAL-FIELD TO W0001-FCST-ID
                   MOVE W0001-FCST-ID      TO M-FCSID-NI
               ELSE
                   MOVE -1                 TO M-FCSID-NL
                   MOVE W9999-MSG-053      TO M-MSG-24I
                   SET ERRORS              TO TRUE
               END-IF
           END-IF.

           IF  NO-ERRORS
               IF  W0001-FCST-ID  = CA-CURR-FCST-ID
               AND W0001-FCST-ID  NOT = ZERO
               AND GOOD-FCST-ID
                   SET OLD-FCST-ID TO TRUE
               ELSE
                   SET GOOD-FCST-ID TO TRUE
                   SET NEW-FCST-ID TO TRUE
               END-IF
           END-IF.


           EJECT
       C110-VALIDATE-DIVISION.

           MOVE 'C110'      TO CA-PARAGRAPH-NBR.

           MOVE M-MKTCDIV-CI  TO F-MKTCDIV-C IN DCLTFDIV.

           EXEC SQL
             SELECT F_MKTCDIV_C
                  , F_MKTCDIV_X
               INTO :DCLTFDIV.F-MKTCDIV-C
                  , :DCLTFDIV.F-MKTCDIV-X
               FROM D108.TFDIV
              WHERE F_MKTCDIV_C = :DCLTFDIV.F-MKTCDIV-C
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               MOVE F-MKTCDIV-X IN DCLTFDIV     TO M-MKTCDIV-XI
           ELSE
               MOVE -1             TO M-MKTCDIV-CL
               MOVE W9999-MSG-009  TO M-MSG-24I
               SET ERRORS          TO TRUE
           END-IF.

           EJECT
       C115-VALIDATE-BU.

           MOVE 'C115'      TO CA-PARAGRAPH-NBR.

           MOVE M-MKTCBU-CI  TO   F-MKTCBU-C IN DCLTFBIZUNT.

           EXEC SQL
             SELECT F_MKTCBU_C
                  , F_MKTCBU_X
               INTO :DCLTFBIZUNT.F-MKTCBU-C
                  , :DCLTFBIZUNT.F-MKTCBU-X
               FROM D108.TFBIZUNT
              WHERE F_MKTCBU_C = :DCLTFBIZUNT.F-MKTCBU-C
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               MOVE F-MKTCBU-X IN DCLTFBIZUNT   TO M-MKTCBU-XI
           ELSE
               MOVE -1             TO M-MKTCBU-CL
               MOVE W9999-MSG-008  TO M-MSG-24I
               SET ERRORS          TO TRUE
           END-IF.

           EJECT
       C120-VALIDATE-REGION.

           MOVE 'C120'      TO CA-PARAGRAPH-NBR.

           MOVE M-MKTCRGN-CI  TO F-MKTCRGN-C IN DCLTFRGN.

           EXEC SQL
             SELECT F_MKTCRGN_C
                  , F_MKTCRGN_X
               INTO :DCLTFRGN.F-MKTCRGN-C
                  , :DCLTFRGN.F-MKTCRGN-X
               FROM D108.TFRGN
              WHERE F_MKTCRGN_C = :DCLTFRGN.F-MKTCRGN-C
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               MOVE F-MKTCRGN-X IN DCLTFRGN TO M-MKTCRGN-XI
           ELSE
               SET ERRORS          TO TRUE
               MOVE -1             TO M-MKTCRGN-CL
               MOVE W9999-MSG-010  TO M-MSG-24I
           END-IF.

           EJECT
       C130-VALIDATE-PRODUCT-LINE.

           MOVE 'C130'      TO CA-PARAGRAPH-NBR.

           MOVE M-DPT-CI     TO F-DPT-C       IN DCLTFPRODLN.
           MOVE M-SUBDPT-CI  TO F-SUBDPT-C    IN DCLTFPRODLN.
           MOVE CA-OP-RGN    TO F-MKTCRGN-C   IN DCLTFPRODLN.

           EXEC SQL
             SELECT F_DPT_C
                  , F_DPT_X
                  , F_MKTCRGN_C
                  , F_MKTCDIV_C
                  , F_MKTCBU_C
                  , F_DPT_X
               INTO :DCLTFPRODLN.F-DPT-C
                  , :DCLTFPRODLN.F-DPT-X
                  , :DCLTFPRODLN.F-MKTCRGN-C
                  , :DCLTFPRODLN.F-MKTCDIV-C
                  , :DCLTFPRODLN.F-MKTCBU-C
                  , :DCLTFPRODLN.F-DPT-X
               FROM D108.TFPRODLN
              WHERE F_DPT_C     = :DCLTFPRODLN.F-DPT-C
                AND F_SUBDPT_C  = :DCLTFPRODLN.F-SUBDPT-C
                AND F_MKTCRGN_C = :DCLTFPRODLN.F-MKTCRGN-C
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               MOVE F-MKTCDIV-C IN DCLTFPRODLN  TO M-MKTCDIV-CI
               MOVE F-MKTCRGN-C IN DCLTFPRODLN  TO M-MKTCRGN-CI
               MOVE F-MKTCBU-C  IN DCLTFPRODLN  TO M-MKTCBU-CI
               MOVE F-DPT-X     IN DCLTFPRODLN  TO M-DPT-XI
           ELSE
              SET ERRORS          TO TRUE
              MOVE -1             TO M-DPT-CL
              MOVE W9999-MSG-011  TO M-MSG-24I
           END-IF.

           EJECT
       C140-VALIDATE-EXPTYP-EXPSUBTYP.

           MOVE 'C140'      TO CA-PARAGRAPH-NBR.

           MOVE M-EXPTYP-CI    TO F-EXPTYP-C    IN DCLTFEXPTYP.
           MOVE M-EXPSUBTYP-CI TO F-EXPSUBTYP-C IN DCLTFEXPTYP.

           EXEC SQL
             SELECT F_EXPTYP_C
                  , F_EXPSUBTYP_C
                  , F_EXPTYP_X
               INTO :DCLTFEXPTYP.F-EXPTYP-C
                  , :DCLTFEXPTYP.F-EXPSUBTYP-C
                  , :DCLTFEXPTYP.F-EXPTYP-X
               FROM D108.TFEXPTYP
              WHERE F_EXPTYP_C    =  :DCLTFEXPTYP.F-EXPTYP-C
                AND F_EXPSUBTYP_C =  :DCLTFEXPTYP.F-EXPSUBTYP-C
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               MOVE F-EXPTYP-X   IN DCLTFEXPTYP  TO M-EXPSUB-XI
           ELSE
               MOVE -1             TO M-EXPTYP-CL
               MOVE W9999-MSG-013  TO M-MSG-24I
               SET ERRORS          TO TRUE
           END-IF.

           EJECT
       C145-VALIDATE-MGRUID.

           MOVE 'C145'      TO CA-PARAGRAPH-NBR.

           MOVE M-MGRUID-CI  TO A-UID-C      IN DCLTFSECACS.

           EXEC SQL
             SELECT A_UID_C
                  , A_BADGE_N
                  , A_EMPNM_X
               INTO :DCLTFSECACS.A-UID-C
                  , :DCLTFSECACS.A-BADGE-N
                  , :DCLTFSECACS.A-EMPNM-X
               FROM D108.TFSECACS
              WHERE A_UID_C  = :DCLTFSECACS.A-UID-C
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               MOVE A-UID-C   IN DCLTFSECACS    TO M-MGRUID-CI
               MOVE A-EMPNM-X IN DCLTFSECACS    TO M-MGRNM-XI
               MOVE A-BADGE-N IN DCLTFSECACS    TO M-BADGE-CI
           ELSE
              MOVE -1             TO M-MGRUID-CL
              MOVE W9999-MSG-030  TO M-MSG-24I
              SET ERRORS          TO TRUE
           END-IF.

           EJECT
       C150-VALIDATE-AMOUNTS.

           MOVE 'C150'      TO CA-PARAGRAPH-NBR.

           PERFORM C155-VALIDATE-EACH-AMOUNT
              VARYING K FROM 1 BY 1
                UNTIL K > WS-TIME-BUCKETS OR ERRORS.

           EJECT
       C155-VALIDATE-EACH-AMOUNT.

           MOVE 'C155'      TO CA-PARAGRAPH-NBR.

           INSPECT M-FCSP-AI (K) REPLACING ALL '_' BY SPACES

           IF  M-FCSP-AI (K) = SPACE OR LOW-VALUES
               NEXT SENTENCE
           ELSE
               MOVE 0  TO  W0001-COUNTER
               INSPECT M-FCSP-AI (K)
                   TALLYING  W0001-COUNTER FOR ALL '-'
                    REPLACING ALL '-'  BY ' '
               MOVE M-FCSP-AI (K)  TO CON-ALPHA-INPUT-FIELD
               MOVE 'D'            TO CON-FIELD-TYPE
               PERFORM B900-CONVERT-NUMERIC
                  THRU B999-CONVERT-END
               IF  CON-OK
                   MOVE CON-NUMERIC-DECIMAL-FIELD TO W0001-FCSP-AI (K)
                   IF  W0001-COUNTER > 0
                       COMPUTE W0001-FCSP-AI (K)
                             = W0001-FCSP-AI (K) * -1
                   END-IF
                   IF  W0001-FCSP-AI (K)  > 9999.9
                       MOVE -1 TO M-FCSP-AL (K)
                       MOVE W9999-MSG-052       TO M-MSG-24I
                       SET ERRORS TO TRUE
                   ELSE
                       MOVE  W0001-FCSP-AI (K)  TO W0001-FCSP-AI-D51
                       MOVE  W0001-FCSP-AI-D41  TO M-FCSP-AI (K)
                   END-IF
               ELSE
                   MOVE -1  TO   M-FCSP-AL (K)
                   MOVE W9999-MSG-051      TO  M-MSG-24I
                   SET ERRORS TO TRUE
               END-IF
           END-IF.

           EJECT
       D000-PROCESS-ADD-KEY.

           MOVE 'D000'      TO CA-PARAGRAPH-NBR.

           MOVE SPACES TO  M-F-PRJ-NI
                           M-STD-AI
                           M-FYSTD-AI
                           M-ATD-AI
                           M-PATOT-AI.

           IF  NOT CA-ENTRY
               SET CA-ENTRY TO TRUE
               SET PF5-FIRST-PASS TO TRUE
               IF (M-MGRUID-CI = SPACES
               AND M-DPT-CI    = SPACES
               AND M-EXPTYP-CI = SPACES
               AND M-FCSID-NI  = SPACES
                  )
                    PERFORM A250-RE-INIT-OUTPUT-VALUES
               ELSE
                    PERFORM D005-PROCESSING-ADD
               END-IF
           ELSE
               PERFORM D005-PROCESSING-ADD
           END-IF.

           EJECT
       D005-PROCESSING-ADD.

           MOVE 'D005'      TO CA-PARAGRAPH-NBR.

           PERFORM B600-SECURITY-CHECK

           IF  SECURITY-OK
               CONTINUE
           ELSE
               SET ERRORS          TO TRUE
               MOV  -1             TO M-DPT-CL
               MOVE W9999-MSG-069  TO M-MSG-24I
           END-IF.

           IF  NO-ERRORS
               PERFORM C000-VALIDATE-INPUT
           END-IF.

           IF  NO-ERRORS
               IF  PF5-FIRST-PASS
                  PERFORM D010-CHECK-FCSTID-EXISTS
               END-IF
           END-IF.

           IF  NO-ERRORS
               PERFORM D050-MOVE-MAP-TO-HOST-VARS
               PERFORM D100-INCREMENT-DFAULT-FCSID
               PERFORM D110-INSERT-FCSHDR-DB
               PERFORM C080-MOVE-AMOUNT-INFO-RETR
           END-IF.

           EJECT
       D010-CHECK-FCSTID-EXISTS.

           MOVE 'D010'      TO CA-PARAGRAPH-NBR.

           IF  OLD-FCST-ID
               MOVE W9999-MSG-120  TO M-MSG-24I
               MOVE -1             TO M-FCSID-NL
               SET ERRORS          TO TRUE
               SET PF5-SECOND-PASS TO TRUE
           ELSE
               IF  M-FCSID-NI EQUAL SPACES OR LOW-VALUES
                   CONTINUE
               ELSE
                   MOVE -1             TO M-FCSID-NL
                   MOVE W9999-MSG-121  TO M-MSG-24I
                   SET PF5-SECOND-PASS TO TRUE
                   SET ERRORS          TO TRUE
               END-IF
           END-IF.

           EJECT
       D050-MOVE-MAP-TO-HOST-VARS.

           MOVE 'D050'      TO CA-PARAGRAPH-NBR.

           MOVE M-MGRUID-CI       TO A-UID-C       IN DCLTFFCSHDR
           MOVE W0001-FCST-ID     TO F-FCSID-N     IN DCLTFFCSHDR
           MOVE M-FCSID-XI        TO F-FCSID-X     IN DCLTFFCSHDR
           MOVE M-CMNT-XI         TO F-CMNT-X      IN DCLTFFCSHDR
           MOVE M-MKTCDIV-CI      TO F-MKTCDIV-C   IN DCLTFFCSHDR
           MOVE M-MKTCRGN-CI      TO F-MKTCRGN-C   IN DCLTFFCSHDR
           MOVE M-DPT-CI          TO F-DPT-C       IN DCLTFFCSHDR
           MOVE M-SUBDPT-CI       TO F-SUBDPT-C    IN DCLTFFCSHDR
           MOVE M-EXPTYP-CI       TO F-EXPTYP-C    IN DCLTFFCSHDR
           MOVE M-EXPSUBTYP-CI    TO F-EXPSUBTYP-C IN DCLTFFCSHDR

           MOVE 0                 TO F-FCSACCR-A   IN DCLTFFCSHDR

           MOVE CA-S-FCSP00-A     TO F-FCSP00-A    IN DCLTFFCSHDR
           MOVE CA-S-FCSP01-A     TO F-FCSP01-A    IN DCLTFFCSHDR
           MOVE CA-S-FCSP02-A     TO F-FCSP02-A    IN DCLTFFCSHDR
           MOVE CA-S-FCSP03-A     TO F-FCSP03-A    IN DCLTFFCSHDR
           MOVE CA-S-FCSP04-A     TO F-FCSP04-A    IN DCLTFFCSHDR
           MOVE CA-S-FCSP05-A     TO F-FCSP05-A    IN DCLTFFCSHDR
           MOVE CA-S-FCSQ02-A     TO F-FCSQ02-A    IN DCLTFFCSHDR
           MOVE CA-S-FCSQ03-A     TO F-FCSQ03-A    IN DCLTFFCSHDR
           MOVE CA-S-FCSQ04-A     TO F-FCSQ04-A    IN DCLTFFCSHDR
           MOVE CA-S-FCSQ05-A     TO F-FCSQ05-A    IN DCLTFFCSHDR

           EVALUATE CA-FISCAL-PERIOD
               WHEN 01
                    MOVE W0001-FCSP-AI (2) TO F-FCSP00-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (3) TO F-FCSP01-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (4) TO F-FCSP02-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (6) TO F-FCSP03-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (7) TO F-FCSQ02-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (8) TO F-FCSQ03-A IN DCLTFFCSHDR
               WHEN 02
                    MOVE W0001-FCSP-AI (3) TO F-FCSP01-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (4) TO F-FCSP02-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (6) TO F-FCSP03-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (7) TO F-FCSQ02-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (8) TO F-FCSQ03-A IN DCLTFFCSHDR
               WHEN 03
                    MOVE W0001-FCSP-AI (4) TO F-FCSP02-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (6) TO F-FCSP03-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (7) TO F-FCSP04-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (8) TO F-FCSP05-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (9) TO F-FCSQ02-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI(10) TO F-FCSQ03-A IN DCLTFFCSHDR
               WHEN 04
                    MOVE W0001-FCSP-AI (3) TO F-FCSP00-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (4) TO F-FCSP01-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (5) TO F-FCSP02-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (7) TO F-FCSP03-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (8) TO F-FCSQ02-A IN DCLTFFCSHDR
               WHEN 05
                    MOVE W0001-FCSP-AI (4) TO F-FCSP01-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (5) TO F-FCSP02-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (7) TO F-FCSP03-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (8) TO F-FCSQ02-A IN DCLTFFCSHDR
               WHEN 06
                    MOVE W0001-FCSP-AI (5) TO F-FCSP02-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (7) TO F-FCSP03-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (8) TO F-FCSP04-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (9) TO F-FCSP05-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI(10) TO F-FCSQ02-A IN DCLTFFCSHDR
               WHEN 07
                    MOVE W0001-FCSP-AI (4) TO F-FCSP00-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (5) TO F-FCSP01-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (6) TO F-FCSP02-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (8) TO F-FCSP03-A IN DCLTFFCSHDR
               WHEN 08
                    MOVE W0001-FCSP-AI (5) TO F-FCSP01-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (6) TO F-FCSP02-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (8) TO F-FCSP03-A IN DCLTFFCSHDR
               WHEN 09
                    MOVE W0001-FCSP-AI (6) TO F-FCSP02-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (8) TO F-FCSP03-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (9) TO F-FCSP04-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI(10) TO F-FCSP05-A IN DCLTFFCSHDR
               WHEN 10
                    MOVE W0001-FCSP-AI (5) TO F-FCSP00-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (6) TO F-FCSP01-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (7) TO F-FCSP02-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI(10) TO F-FCSP03-A IN DCLTFFCSHDR
               WHEN 11
                    MOVE W0001-FCSP-AI (6) TO F-FCSP01-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (7) TO F-FCSP02-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI(10) TO F-FCSP03-A IN DCLTFFCSHDR
               WHEN 12
                    MOVE W0001-FCSP-AI (6) TO F-FCSP02-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI (9) TO F-FCSP03-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI(10) TO F-FCSP04-A IN DCLTFFCSHDR
                    MOVE W0001-FCSP-AI(11) TO F-FCSP05-A IN DCLTFFCSHDR
           END-EVALUATE.

           MOVE F-FCSP00-A IN DCLTFFCSHDR  TO CA-S-FCSP00-A.
           MOVE F-FCSP01-A IN DCLTFFCSHDR  TO CA-S-FCSP01-A.
           MOVE F-FCSP02-A IN DCLTFFCSHDR  TO CA-S-FCSP02-A.
           MOVE F-FCSP03-A IN DCLTFFCSHDR  TO CA-S-FCSP03-A.
           MOVE F-FCSP04-A IN DCLTFFCSHDR  TO CA-S-FCSP04-A.
           MOVE F-FCSP05-A IN DCLTFFCSHDR  TO CA-S-FCSP05-A.
           MOVE F-FCSQ02-A IN DCLTFFCSHDR  TO CA-S-FCSQ02-A.
           MOVE F-FCSQ03-A IN DCLTFFCSHDR  TO CA-S-FCSQ03-A.
           MOVE F-FCSQ04-A IN DCLTFFCSHDR  TO CA-S-FCSQ04-A.
           MOVE F-FCSQ05-A IN DCLTFFCSHDR  TO CA-S-FCSQ05-A.

           EJECT
       D100-INCREMENT-DFAULT-FCSID.

           MOVE 'D100'      TO CA-PARAGRAPH-NBR.

           MOVE CA-OP-RGN   TO F-MKTCRGN-C IN DCLTFPRODLN.

           EXEC SQL
             SELECT F_FCSID_N
              INTO :DCLTFDFAULT.F-FCSID-N
              FROM D108.TFDFAULT
             WHERE F_MKTCRGN_C = :DCLTFPRODLN.F-MKTCRGN-C
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               CONTINUE
           ELSE
               MOVE -1             TO M-EXPTYP-CL
               MOVE W9999-MSG-013  TO M-MSG-24I
               SET ERRORS          TO TRUE
           END-IF.

           IF  NO-ERRORS
               ADD 1  TO F-FCSID-N  IN DCLTFDFAULT
               EXEC SQL
                    UPDATE D108.TFDFAULT
                       SET F_FCSID_N =  :DCLTFDFAULT.F-FCSID-N
                     WHERE F_MKTCRGN_C = :DCLTFPRODLN.F-MKTCRGN-C
               END-EXEC
           END-IF.

           SET NORMAL-RC-ONLY  TO TRUE
           PERFORM Z900-DB2-CHECK.

           EJECT
       D110-INSERT-FCSHDR-DB.

           MOVE 'D110'      TO CA-PARAGRAPH-NBR.
           MOVE  F-FCSID-N  IN  DCLTFDFAULT TO  W0001-FCST-ID
                                F-FCSID-N  IN  DCLTFFCSHDR.
           EXEC SQL
             INSERT INTO D108.TFFCSHDR
                  ( F_FCSID_N
                  , F_DPT_C
                  , F_SUBDPT_C
                  , F_FCSID_X
                  , F_CMNT_X
                  , F_MKTCRGN_C
                  , F_MKTCDIV_C
                  , F_EXPTYP_C
                  , F_EXPSUBTYP_C
                  , A_UID_C
                  , F_FCSP00_A
                  , F_FCSP01_A
                  , F_FCSP02_A
                  , F_FCSP03_A
                  , F_FCSP04_A
                  , F_FCSP05_A
                  , F_FCSACCR_A
                  , F_FCSQ02_A
                  , F_FCSQ03_A
                  , F_FCSQ04_A
                  , F_FCSQ05_A )
             VALUES
                  ( :DCLTFFCSHDR.F-FCSID-N
                  , :DCLTFFCSHDR.F-DPT-C
                  , :DCLTFFCSHDR.F-SUBDPT-C
                  , :DCLTFFCSHDR.F-FCSID-X
                  , :DCLTFFCSHDR.F-CMNT-X
                  , :DCLTFFCSHDR.F-MKTCRGN-C
                  , :DCLTFFCSHDR.F-MKTCDIV-C
                  , :DCLTFFCSHDR.F-EXPTYP-C
                  , :DCLTFFCSHDR.F-EXPSUBTYP-C
                  , :DCLTFFCSHDR.A-UID-C
                  , :DCLTFFCSHDR.F-FCSP00-A
                  , :DCLTFFCSHDR.F-FCSP01-A
                  , :DCLTFFCSHDR.F-FCSP02-A
                  , :DCLTFFCSHDR.F-FCSP03-A
                  , :DCLTFFCSHDR.F-FCSP04-A
                  , :DCLTFFCSHDR.F-FCSP05-A
                  , :DCLTFFCSHDR.F-FCSACCR-A
                  , :DCLTFFCSHDR.F-FCSQ02-A
                  , :DCLTFFCSHDR.F-FCSQ03-A
                  , :DCLTFFCSHDR.F-FCSQ04-A
                  , :DCLTFFCSHDR.F-FCSQ05-A )
           END-EXEC.

           SET DUP-KEY  TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               MOVE W0001-FCST-ID   TO  CA-CURR-FCST-ID
               MOVE -1              TO M-FCSID-NL
               MOVE W9999-MSG-015   TO M-MSG-24I
               MOVE W0001-FCST-ID   TO M-FCSID-NI
               SET  PF5-FIRST-PASS  TO TRUE
               SET  CA-UPDATE       TO TRUE
           ELSE
               MOVE -1              TO M-FCSID-NL
               MOVE W9999-MSG-014   TO M-MSG-24I
               SET ERRORS           TO TRUE
           END-IF.

           EJECT
       E000-PROCESS-UPD-KEY.

           MOVE 'E000'      TO CA-PARAGRAPH-NBR.

           IF  NOT CA-UPDATE
               PERFORM E020-UPD-MODE-NEW
           ELSE
               PERFORM E040-UPD-MODE-OLD
           END-IF.

           EJECT
       E020-UPD-MODE-NEW.

           MOVE 'E020'      TO CA-PARAGRAPH-NBR.

           IF  M-FCSID-NI  EQUAL TO SPACES OR  LOW-VALUES
               PERFORM E025-PROMPT-FCST-ID
           ELSE
               SET CA-UPDATE   TO  TRUE
               PERFORM A250-RE-INIT-OUTPUT-VALUES
           END-IF.

           EJECT
       E025-PROMPT-FCST-ID.

            MOVE  W9999-MSG-047     TO M-MSG-24I
            MOVE -1                 TO M-FCSID-NL
            SET CA-PROMPT           TO TRUE
            PERFORM A220-CLEAR-OUTPUT-FLDS.

           EJECT
       E040-UPD-MODE-OLD.

           MOVE 'E040'      TO CA-PARAGRAPH-NBR.

           IF  OLD-FCST-ID
               PERFORM E100-DO-UPDATE
           ELSE
               PERFORM A250-RE-INIT-OUTPUT-VALUES
           END-IF.

           EJECT
       E100-DO-UPDATE.

           MOVE 'E100'      TO CA-PARAGRAPH-NBR.

           PERFORM B600-SECURITY-CHECK
           IF  SECURITY-OK
               CONTINUE
           ELSE
               SET ERRORS          TO TRUE
               MOVE  -1            TO M-DPT-CL
               MOVE W9999-MSG-069  TO M-MSG-24I
           END-IF.

           IF  NO-ERRORS
               PERFORM C000-VALIDATE-INPUT
           END-IF.

           IF  NO-ERRORS
               PERFORM D050-MOVE-MAP-TO-HOST-VARS
               PERFORM E120-UPDATE-FCSHDR-DB
           END-IF.

           IF  NO-ERRORS
               PERFORM E130-READ-PRJHDR-DB
               PERFORM C080-MOVE-AMOUNT-INFO-RETR
               PERFORM E140-PROCESS-UPDATE-AUDIT
           END-IF.

           EJECT
       E110-RETRIEVE-FCST-DATA.

           MOVE 'E110'      TO CA-PARAGRAPH-NBR.

           PERFORM E115-READ-FCSHDR-DB.

           IF  NO-ERRORS
               PERFORM E116-GET-AUDIT-INFO
           END-IF.

           IF  NO-ERRORS
               PERFORM E130-READ-PRJHDR-DB
           END-IF.

           IF  NO-ERRORS
               PERFORM E135-READ-FCSHST-DB
           END-IF.

           IF  NO-ERRORS
               PERFORM C070-MOVE-HEADER-INFO-RETR
           END-IF.

           IF  NO-ERRORS
               PERFORM C080-MOVE-AMOUNT-INFO-RETR
           END-IF.

           EJECT
       E115-READ-FCSHDR-DB.

           MOVE 'E115'      TO CA-PARAGRAPH-NBR.

           INITIALIZE  DCLTFFCSHDR
           MOVE W0001-FCST-ID  TO F-FCSID-N   IN DCLTFFCSHDR.
           MOVE CA-OP-RGN      TO F-MKTCRGN-C IN DCLTFPRODLN.

           EXEC SQL
             SELECT F_FCSID_N
                  , F_DPT_C
                  , F_SUBDPT_C
                  , F_FCSID_X
                  , F_CMNT_X
                  , F_MKTCRGN_C
                  , F_MKTCDIV_C
                  , F_PRMACCT_C
                  , F_EXPTYP_C
                  , F_EXPSUBTYP_C
                  , A_UID_C
                  , F_FCSP00_A
                  , F_FCSP01_A
                  , F_FCSP02_A
                  , F_FCSP03_A
                  , F_FCSP04_A
                  , F_FCSP05_A
                  , F_FCSACCR_A
                  , F_FCSQ02_A
                  , F_FCSQ03_A
                  , F_FCSQ04_A
                  , F_FCSQ05_A
               INTO :DCLTFFCSHDR.F-FCSID-N
                  , :DCLTFFCSHDR.F-DPT-C
                  , :DCLTFFCSHDR.F-SUBDPT-C
                  , :DCLTFFCSHDR.F-FCSID-X
                  , :DCLTFFCSHDR.F-CMNT-X
                  , :DCLTFFCSHDR.F-MKTCRGN-C
                  , :DCLTFFCSHDR.F-MKTCDIV-C
                  , :DCLTFFCSHDR.F-PRMACCT-C
                  , :DCLTFFCSHDR.F-EXPTYP-C
                  , :DCLTFFCSHDR.F-EXPSUBTYP-C
                  , :DCLTFFCSHDR.A-UID-C
                  , :DCLTFFCSHDR.F-FCSP00-A
                  , :DCLTFFCSHDR.F-FCSP01-A
                  , :DCLTFFCSHDR.F-FCSP02-A
                  , :DCLTFFCSHDR.F-FCSP03-A
                  , :DCLTFFCSHDR.F-FCSP04-A
                  , :DCLTFFCSHDR.F-FCSP05-A
                  , :DCLTFFCSHDR.F-FCSACCR-A
                  , :DCLTFFCSHDR.F-FCSQ02-A
                  , :DCLTFFCSHDR.F-FCSQ03-A
                  , :DCLTFFCSHDR.F-FCSQ04-A
                  , :DCLTFFCSHDR.F-FCSQ05-A
               FROM D108.TFFCSHDR
              WHERE F_FCSID_N   = :DCLTFFCSHDR.F-FCSID-N
                AND F_MKTCRGN_C = :DCLTFPRODLN.F-MKTCRGN-C
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               MOVE W0001-FCST-ID  TO CA-CURR-FCST-ID
               MOVE DCLTFFCSHDR    TO CA-DCLTFFCSHDR-SAVE

               MOVE F-FCSP00-A IN DCLTFFCSHDR  TO CA-S-FCSP00-A
               MOVE F-FCSP01-A IN DCLTFFCSHDR  TO CA-S-FCSP01-A
               MOVE F-FCSP02-A IN DCLTFFCSHDR  TO CA-S-FCSP02-A
               MOVE F-FCSP03-A IN DCLTFFCSHDR  TO CA-S-FCSP03-A
               MOVE F-FCSP04-A IN DCLTFFCSHDR  TO CA-S-FCSP04-A
               MOVE F-FCSP05-A IN DCLTFFCSHDR  TO CA-S-FCSP05-A
               MOVE F-FCSQ02-A IN DCLTFFCSHDR  TO CA-S-FCSQ02-A
               MOVE F-FCSQ03-A IN DCLTFFCSHDR  TO CA-S-FCSQ03-A
               MOVE F-FCSQ04-A IN DCLTFFCSHDR  TO CA-S-FCSQ04-A
               MOVE F-FCSQ05-A IN DCLTFFCSHDR  TO CA-S-FCSQ05-A
           ELSE
               MOVE -1             TO M-FCSID-NL
               MOVE W9999-MSG-032  TO M-MSG-24I
               MOVE ZEROS          TO CA-CURR-FCST-ID
               SET BAD-FCST-ID     TO TRUE
               SET ERRORS          TO TRUE
           END-IF.

           EJECT
       E116-GET-AUDIT-INFO.

           MOVE 'E116'      TO CA-PARAGRAPH-NBR.

           MOVE CA-OP-RGN                     TO W0001-K7-F-MKTCRGN-C.
           MOVE F-FCSID-N     IN DCLTFFCSHDR  TO W0001-K7-F-FCSID-C.

           MOVE CA-OP-RGN     TO F-MKTCRGN-C  IN DCLTFPRODLN.

           EXEC SQL
                OPEN CSR_3
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.

           EXEC SQL
             FETCH CSR_3
              INTO :DCLTFAUDIT.A-UID-C
                 , :DCLTFAUDIT.DB-UPD-D
                 , :DCLTFAUDIT.DB-UPD-T
                 , :DCLTFSECACS.A-EMPNM-X
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               MOVE DB-UPD-D  IN DCLTFAUDIT (1:6)
                 TO M-LASTUPD-DI (1:6)
               MOVE DB-UPD-D  IN DCLTFAUDIT (9:2)
                 TO M-LASTUPD-DI (7:2)
               MOVE A-UID-C   IN DCLTFAUDIT (1:7)
                 TO M-LASTUPD-XI (1:7)
               MOVE '- '
                 TO M-LASTUPD-XI (8:2)
               MOVE A-EMPNM-X IN DCLTFSECACS
                 TO M-LASTUPD-XI (10:20)
           ELSE
               MOVE SPACES  TO M-LASTUPD-DI
               MOVE SPACES  TO M-LASTUPD-XI
           END-IF.

           EXEC SQL
                CLOSE CSR_3
           END-EXEC.

           SET OPEN-O-CLOSE-CURSOR TO TRUE.
           PERFORM Z900-DB2-CHECK.


           EJECT
       E120-UPDATE-FCSHDR-DB.

           MOVE 'E120'      TO CA-PARAGRAPH-NBR.

           MOVE W0001-FCST-ID  TO F-FCSID-N   IN DCLTFFCSHDR.
           MOVE CA-OP-RGN      TO F-MKTCRGN-C IN DCLTFPRODLN.

           EXEC SQL
             UPDATE D108.TFFCSHDR
                SET F_DPT_C       = :DCLTFFCSHDR.F-DPT-C
                  , F_SUBDPT_C    = :DCLTFFCSHDR.F-SUBDPT-C
                  , F_FCSID_X     = :DCLTFFCSHDR.F-FCSID-X
                  , F_CMNT_X      = :DCLTFFCSHDR.F-CMNT-X
                  , F_MKTCDIV_C   = :DCLTFFCSHDR.F-MKTCDIV-C
                  , F_PRMACCT_C   = :DCLTFFCSHDR.F-PRMACCT-C
                  , F_EXPTYP_C    = :DCLTFFCSHDR.F-EXPTYP-C
                  , F_EXPSUBTYP_C = :DCLTFFCSHDR.F-EXPSUBTYP-C
                  , A_UID_C       = :DCLTFFCSHDR.A-UID-C
                  , F_FCSP00_A    = :DCLTFFCSHDR.F-FCSP00-A
                  , F_FCSP01_A    = :DCLTFFCSHDR.F-FCSP01-A
                  , F_FCSP02_A    = :DCLTFFCSHDR.F-FCSP02-A
                  , F_FCSP03_A    = :DCLTFFCSHDR.F-FCSP03-A
                  , F_FCSP04_A    = :DCLTFFCSHDR.F-FCSP04-A
                  , F_FCSP05_A    = :DCLTFFCSHDR.F-FCSP05-A
                  , F_FCSACCR_A   = :DCLTFFCSHDR.F-FCSACCR-A
                  , F_FCSQ02_A    = :DCLTFFCSHDR.F-FCSQ02-A
                  , F_FCSQ03_A    = :DCLTFFCSHDR.F-FCSQ03-A
                  , F_FCSQ04_A    = :DCLTFFCSHDR.F-FCSQ04-A
                  , F_FCSQ05_A    = :DCLTFFCSHDR.F-FCSQ05-A
                  , DB_UPD_D      = CURRENT DATE
                  , DB_UPD_T      = CURRENT TIME
              WHERE F_FCSID_N     = :DCLTFFCSHDR.F-FCSID-N
                AND F_MKTCRGN_C   = :DCLTFPRODLN.F-MKTCRGN-C
           END-EXEC.

           SET NORMAL-RC-ONLY  TO TRUE.

           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               EXEC SQL
                 UPDATE D108.TFPRJHDR
                    SET F_PRJ_X       = :DCLTFFCSHDR.F-FCSID-X
                  WHERE F_FCSID_N     = :DCLTFFCSHDR.F-FCSID-N
                    AND F_MKTCRGN_C   = :DCLTFPRODLN.F-MKTCRGN-C
               END-EXEC

               PERFORM Z900-DB2-CHECK

               MOVE -1              TO M-FCSID-NL
               MOVE W9999-MSG-042   TO M-MSG-24I
               MOVE W0001-FCST-ID   TO CA-CURR-FCST-ID
           END-IF.

           EJECT
       E130-READ-PRJHDR-DB.

           MOVE 'E130'      TO CA-PARAGRAPH-NBR.

           INITIALIZE  DCLTFPRJHDR.
           MOVE CA-OP-RGN   TO F-MKTCRGN-C IN DCLTFPRODLN.

           EXEC SQL
             SELECT F_PRJ_N
                  , F_DPT_C
                  , F_SUBDPT_C
                  , F_FCSID_N
                  , F_PRJ_X
                  , F_CMNT_X
                  , F_MKTCRGN_C
                  , F_MKTCDIV_C
                  , F_EXPTYP_C
                  , F_EXPSUBTYP_C
                  , A_UID_C
                  , P_TOT_A
                  , P_STRT_D
                  , P_ACT_A
                  , P_ACCR_A
                  , P_ACTP01_A
                  , P_ACTP02_A
                  , P_ACTP03_A
                  , P_ACTQ01_A
                  , P_ACTH01_A
                  , DB_UPD_D
                  , DB_UPD_T
               INTO :DCLTFPRJHDR.F-PRJ-N
                  , :DCLTFPRJHDR.F-DPT-C
                  , :DCLTFPRJHDR.F-SUBDPT-C
                  , :DCLTFPRJHDR.F-FCSID-N
                  , :DCLTFPRJHDR.F-PRJ-X
                  , :DCLTFPRJHDR.F-CMNT-X
                  , :DCLTFPRJHDR.F-MKTCRGN-C
                  , :DCLTFPRJHDR.F-MKTCDIV-C
                  , :DCLTFPRJHDR.F-EXPTYP-C
                  , :DCLTFPRJHDR.F-EXPSUBTYP-C
                  , :DCLTFPRJHDR.A-UID-C
                  , :DCLTFPRJHDR.P-TOT-A
                  , :DCLTFPRJHDR.P-STRT-D
                  , :DCLTFPRJHDR.P-ACT-A
                  , :DCLTFPRJHDR.P-ACCR-A
                  , :DCLTFPRJHDR.P-ACTP01-A
                  , :DCLTFPRJHDR.P-ACTP02-A
                  , :DCLTFPRJHDR.P-ACTP03-A
                  , :DCLTFPRJHDR.P-ACTQ01-A
                  , :DCLTFPRJHDR.P-ACTH01-A
                  , :DCLTFPRJHDR.DB-UPD-D
                  , :DCLTFPRJHDR.DB-UPD-T
               FROM D108.TFPRJHDR
              WHERE F_FCSID_N   = :DCLTFFCSHDR.F-FCSID-N
                AND F_MKTCRGN_C = :DCLTFPRODLN.F-MKTCRGN-C
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               MOVE P-ACTP01-A  IN DCLTFPRJHDR  TO CA-P-ACTP01-R
               MOVE P-ACTP02-A  IN DCLTFPRJHDR  TO CA-P-ACTP02-R
               MOVE P-ACTP03-A  IN DCLTFPRJHDR  TO CA-P-ACTP03-R
               MOVE P-ACTQ01-A  IN DCLTFPRJHDR  TO CA-P-ACTQ01-R
               MOVE P-ACTH01-A  IN DCLTFPRJHDR  TO CA-P-ACTH01-R

               IF  P-ACTP01-A         IN DCLTFPRJHDR IS NEGATIVE
                   COMPUTE P-ACTP01-A IN DCLTFPRJHDR =
                         ((P-ACTP01-A IN DCLTFPRJHDR - 500) / 1000)
               ELSE
                   COMPUTE P-ACTP01-A IN DCLTFPRJHDR =
                         ((P-ACTP01-A IN DCLTFPRJHDR + 500) / 1000)
               END-IF

               IF  P-ACTP02-A         IN DCLTFPRJHDR IS NEGATIVE
                   COMPUTE P-ACTP02-A IN DCLTFPRJHDR =
                         ((P-ACTP02-A IN DCLTFPRJHDR - 500) / 1000)
               ELSE
                   COMPUTE P-ACTP02-A IN DCLTFPRJHDR =
                         ((P-ACTP02-A IN DCLTFPRJHDR + 500) / 1000)
               END-IF

               IF  P-ACTP03-A         IN DCLTFPRJHDR IS NEGATIVE
                   COMPUTE P-ACTP03-A IN DCLTFPRJHDR =
                         ((P-ACTP03-A IN DCLTFPRJHDR - 500) / 1000)
               ELSE
                   COMPUTE P-ACTP03-A IN DCLTFPRJHDR =
                         ((P-ACTP03-A IN DCLTFPRJHDR + 500) / 1000)
               END-IF

               IF  P-ACTQ01-A         IN DCLTFPRJHDR IS NEGATIVE
                   COMPUTE P-ACTQ01-A IN DCLTFPRJHDR =
                         ((P-ACTQ01-A IN DCLTFPRJHDR - 500) / 1000)
               ELSE
                   COMPUTE P-ACTQ01-A IN DCLTFPRJHDR =
                         ((P-ACTQ01-A IN DCLTFPRJHDR + 500) / 1000)
               END-IF
               MOVE P-ACTQ01-A IN DCLTFPRJHDR TO W0001-Q1A-SAVE

               IF  P-ACTH01-A         IN DCLTFPRJHDR IS NEGATIVE
                   COMPUTE P-ACTH01-A IN DCLTFPRJHDR =
                         ((P-ACTH01-A IN DCLTFPRJHDR - 500) / 1000)
               ELSE
                   COMPUTE P-ACTH01-A IN DCLTFPRJHDR =
                         ((P-ACTH01-A IN DCLTFPRJHDR + 500) / 1000)
               END-IF
               MOVE P-ACTH01-A IN DCLTFPRJHDR TO W0001-H01A-SAVE

               IF  P-TOT-A            IN DCLTFPRJHDR IS NEGATIVE
                   COMPUTE P-TOT-A IN DCLTFPRJHDR =
                         ((P-TOT-A IN DCLTFPRJHDR - 500) / 1000)
               ELSE
                   COMPUTE P-TOT-A IN DCLTFPRJHDR =
                         ((P-TOT-A IN DCLTFPRJHDR + 500) / 1000)
               END-IF

               IF  P-ACT-A            IN DCLTFPRJHDR IS NEGATIVE
                   COMPUTE P-ACT-A IN DCLTFPRJHDR =
                         ((P-ACT-A IN DCLTFPRJHDR - 500) / 1000)
               ELSE
                   COMPUTE P-ACT-A IN DCLTFPRJHDR =
                         ((P-ACT-A IN DCLTFPRJHDR + 500) / 1000)
               END-IF

               IF  P-ACCR-A           IN DCLTFPRJHDR IS NEGATIVE
                   COMPUTE P-ACCR-A IN DCLTFPRJHDR =
                         ((P-ACCR-A IN DCLTFPRJHDR - 500) / 1000)
               ELSE
                   COMPUTE P-ACCR-A IN DCLTFPRJHDR =
                         ((P-ACCR-A IN DCLTFPRJHDR + 500) / 1000)
               END-IF

               MOVE P-ACTP01-A  IN DCLTFPRJHDR  TO CA-P-ACTP01-A
               MOVE P-ACTP02-A  IN DCLTFPRJHDR  TO CA-P-ACTP02-A
               MOVE P-ACTP03-A  IN DCLTFPRJHDR  TO CA-P-ACTP03-A
               MOVE P-ACTQ01-A  IN DCLTFPRJHDR  TO CA-P-ACTQ01-A
               MOVE P-ACTH01-A  IN DCLTFPRJHDR  TO CA-P-ACTH01-A

               SET TFPRJHDR-OK  TO TRUE
           ELSE
               INITIALIZE DCLTFPRJHDR
               MOVE ZEROES TO CA-P-ACTP01-A
                              CA-P-ACTP02-A
                              CA-P-ACTP02-A
                              CA-P-ACTQ01-A
                              CA-P-ACTH01-A
                              CA-P-ACTP01-R
                              CA-P-ACTP02-R
                              CA-P-ACTP02-R
                              CA-P-ACTQ01-R
                              CA-P-ACTH01-R
                              P-ACTP01-A  IN DCLTFPRJHDR
                              P-ACTP02-A  IN DCLTFPRJHDR
                              P-ACTP03-A  IN DCLTFPRJHDR
                              P-ACTQ01-A  IN DCLTFPRJHDR
                              P-ACTH01-A  IN DCLTFPRJHDR
               SET TFPRJHDR-NO-DATA   TO TRUE
           END-IF.

           EJECT
       E135-READ-FCSHST-DB.

           MOVE 'E135'      TO CA-PARAGRAPH-NBR.

           INITIALIZE  DCLTFFCSHST.

           MOVE CA-OP-RGN   TO F-MKTCRGN-C IN DCLTFPRODLN.

           EXEC SQL
             SELECT P_ACTP01_A
                  , P_ACTP02_A
                  , P_ACTP03_A
                  , P_ACTP04_A
                  , P_ACTP05_A
                  , P_ACTP06_A
                  , P_ACTP07_A
                  , P_ACTP08_A
                  , P_ACTP09_A
               INTO :DCLTFFCSHST.P-ACTP01-A
                  , :DCLTFFCSHST.P-ACTP02-A
                  , :DCLTFFCSHST.P-ACTP03-A
                  , :DCLTFFCSHST.P-ACTP04-A
                  , :DCLTFFCSHST.P-ACTP05-A
                  , :DCLTFFCSHST.P-ACTP06-A
                  , :DCLTFFCSHST.P-ACTP07-A
                  , :DCLTFFCSHST.P-ACTP08-A
                  , :DCLTFFCSHST.P-ACTP09-A
               FROM D108.TFFCSHST
              WHERE F_FCSID_N   = :DCLTFFCSHDR.F-FCSID-N
                AND F_MKTCRGN_C = :DCLTFPRODLN.F-MKTCRGN-C
                AND F_DPT_C     = :DCLTFPRJHDR.F-DPT-C
                AND F_SUBDPT_C  = :DCLTFPRJHDR.F-SUBDPT-C
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               IF  P-ACTP01-A         IN DCLTFFCSHST IS NEGATIVE
                   COMPUTE P-ACTP01-A IN DCLTFFCSHST =
                         ((P-ACTP01-A IN DCLTFFCSHST - 500) / 1000)
               ELSE
                   COMPUTE P-ACTP01-A IN DCLTFFCSHST =
                         ((P-ACTP01-A IN DCLTFFCSHST + 500) / 1000)
               END-IF

               IF  P-ACTP02-A         IN DCLTFFCSHST IS NEGATIVE
                   COMPUTE P-ACTP02-A IN DCLTFFCSHST =
                         ((P-ACTP02-A IN DCLTFFCSHST - 500) / 1000)
               ELSE
                   COMPUTE P-ACTP02-A IN DCLTFFCSHST =
                         ((P-ACTP02-A IN DCLTFFCSHST + 500) / 1000)
               END-IF

               IF  P-ACTP03-A         IN DCLTFFCSHST IS NEGATIVE
                   COMPUTE P-ACTP03-A IN DCLTFFCSHST =
                         ((P-ACTP03-A IN DCLTFFCSHST - 500) / 1000)
               ELSE
                   COMPUTE P-ACTP03-A IN DCLTFFCSHST =
                         ((P-ACTP03-A IN DCLTFFCSHST + 500) / 1000)
               END-IF

               IF  P-ACTP04-A         IN DCLTFFCSHST IS NEGATIVE
                   COMPUTE P-ACTP04-A IN DCLTFFCSHST =
                         ((P-ACTP04-A IN DCLTFFCSHST - 500) / 1000)
               ELSE
                   COMPUTE P-ACTP04-A IN DCLTFFCSHST =
                         ((P-ACTP04-A IN DCLTFFCSHST + 500) / 1000)
               END-IF

               IF  P-ACTP05-A         IN DCLTFFCSHST IS NEGATIVE
                   COMPUTE P-ACTP05-A IN DCLTFFCSHST =
                         ((P-ACTP05-A IN DCLTFFCSHST - 500) / 1000)
               ELSE
                   COMPUTE P-ACTP05-A IN DCLTFFCSHST =
                         ((P-ACTP05-A IN DCLTFFCSHST + 500) / 1000)
               END-IF

               IF  P-ACTP06-A         IN DCLTFFCSHST IS NEGATIVE
                   COMPUTE P-ACTP06-A IN DCLTFFCSHST =
                         ((P-ACTP06-A IN DCLTFFCSHST - 500) / 1000)
               ELSE
                   COMPUTE P-ACTP06-A IN DCLTFFCSHST =
                         ((P-ACTP06-A IN DCLTFFCSHST + 500) / 1000)
               END-IF

               IF  P-ACTP07-A         IN DCLTFFCSHST IS NEGATIVE
                   COMPUTE P-ACTP07-A IN DCLTFFCSHST =
                         ((P-ACTP07-A IN DCLTFFCSHST - 500) / 1000)
               ELSE
                   COMPUTE P-ACTP07-A IN DCLTFFCSHST =
                         ((P-ACTP07-A IN DCLTFFCSHST + 500) / 1000)
               END-IF

               IF  P-ACTP08-A         IN DCLTFFCSHST IS NEGATIVE
                   COMPUTE P-ACTP08-A IN DCLTFFCSHST =
                         ((P-ACTP08-A IN DCLTFFCSHST - 500) / 1000)
               ELSE
                   COMPUTE P-ACTP08-A IN DCLTFFCSHST =
                         ((P-ACTP08-A IN DCLTFFCSHST + 500) / 1000)
               END-IF

               IF  P-ACTP09-A         IN DCLTFFCSHST IS NEGATIVE
                   COMPUTE P-ACTP09-A IN DCLTFFCSHST =
                         ((P-ACTP09-A IN DCLTFFCSHST - 500) / 1000)
               ELSE
                   COMPUTE P-ACTP09-A IN DCLTFFCSHST =
                         ((P-ACTP09-A IN DCLTFFCSHST + 500) / 1000)
               END-IF

               MOVE P-ACTP01-A  IN DCLTFFCSHST  TO CA-H-ACTP01-A
               MOVE P-ACTP02-A  IN DCLTFFCSHST  TO CA-H-ACTP02-A
               MOVE P-ACTP03-A  IN DCLTFFCSHST  TO CA-H-ACTP03-A
               MOVE P-ACTP04-A  IN DCLTFFCSHST  TO CA-H-ACTP04-A
               MOVE P-ACTP05-A  IN DCLTFFCSHST  TO CA-H-ACTP05-A
               MOVE P-ACTP06-A  IN DCLTFFCSHST  TO CA-H-ACTP06-A
               MOVE P-ACTP07-A  IN DCLTFFCSHST  TO CA-H-ACTP07-A
               MOVE P-ACTP08-A  IN DCLTFFCSHST  TO CA-H-ACTP08-A
               MOVE P-ACTP09-A  IN DCLTFFCSHST  TO CA-H-ACTP09-A
           ELSE
              INITIALIZE DCLTFFCSHST
              MOVE ZEROS TO  CA-H-ACTP01-A
                             CA-H-ACTP02-A
                             CA-H-ACTP03-A
                             CA-H-ACTP04-A
                             CA-H-ACTP05-A
                             CA-H-ACTP06-A
                             CA-H-ACTP07-A
                             CA-H-ACTP08-A
                             CA-H-ACTP09-A
           END-IF.

           EJECT
       E140-PROCESS-UPDATE-AUDIT.

           MOVE 'E140'      TO CA-PARAGRAPH-NBR.

           MOVE 'TFFCSHDR'  TO DB-TBLNAME-X      IN DCLTFAUDIT.
           MOVE CA-OP-ID    TO A-UID-C           IN DCLTFAUDIT.
           MOVE 'U'         TO DB-ACTN-C         IN DCLTFAUDIT.
           MOVE 'B'         TO DB-DATAIMG-C      IN DCLTFAUDIT.
           MOVE CA-DCLTFFCSHDR-SAVE
             TO DB-DATAIMG-X-TEXT IN DCLTFAUDIT.
           MOVE LENGTH OF DCLTFFCSHDR
             TO DB-DATAIMG-X-LEN  IN DCLTFAUDIT.

           PERFORM E150-INSERT-TFAUDIT.

           IF  NO-ERRORS
               PERFORM E115-READ-FCSHDR-DB
               IF  NO-ERRORS
                   MOVE 'A'         TO DB-DATAIMG-C      IN DCLTFAUDIT
                   MOVE DCLTFFCSHDR TO DB-DATAIMG-X-TEXT IN DCLTFAUDIT
                   PERFORM E150-INSERT-TFAUDIT
                   PERFORM E116-GET-AUDIT-INFO
               END-IF
           END-IF.

           EJECT
       E150-INSERT-TFAUDIT.

           MOVE 'E150'      TO CA-PARAGRAPH-NBR.

           EXEC SQL
               INSERT INTO D108.TFAUDIT
                   ( DB_TBLNAME_X
                   , DB_ACTN_C
                   , A_UID_C
                   , DB_UPD_D
                   , DB_UPD_T
                   , DB_DATAIMG_C
                   , DB_DATAIMG_X
                   )
               VALUES
                   ( :DCLTFAUDIT.DB-TBLNAME-X
                   , :DCLTFAUDIT.DB-ACTN-C
                   , :DCLTFAUDIT.A-UID-C
                   , CURRENT DATE
                   , CURRENT TIME
                   , :DCLTFAUDIT.DB-DATAIMG-C
                   , :DCLTFAUDIT.DB-DATAIMG-X
                   )
           END-EXEC.

           PERFORM Z900-DB2-CHECK.

           EJECT
       G000-PROCESS-DEL-KEY.

           MOVE 'G000'      TO CA-PARAGRAPH-NBR.

           IF  NOT CA-DELETE
               PERFORM G020-DEL-MODE-NEW
           ELSE
               PERFORM G040-DEL-MODE-OLD
           END-IF.

           EJECT
       G020-DEL-MODE-NEW.

           MOVE 'G020'      TO CA-PARAGRAPH-NBR.

           IF  W0001-FCST-ID IS EQUAL TO SPACES OR ZERO OR LOW-VALUES
               PERFORM E025-PROMPT-FCST-ID
           ELSE
               IF  M-F-PRJ-NI     = SPACES
                   IF  CA-P-ACTP01-A  = ZEROES
                   AND CA-P-ACTP02-A  = ZEROES
                   AND CA-P-ACTP03-A  = ZEROES
                   AND CA-P-ACTQ01-A  = ZEROES
                   AND CA-P-ACTH01-A  = ZEROES
                       SET CA-DELETE       TO TRUE
                       PERFORM A250-RE-INIT-OUTPUT-VALUES
                   ELSE
                       SET ERRORS          TO TRUE
                       MOVE -1             TO M-FCSID-NL
                       MOVE W9999-MSG-067  TO M-MSG-24I
                   END-IF
               ELSE
                   SET ERRORS          TO TRUE
                   MOVE -1             TO M-FCSID-NL
                   MOVE W9999-MSG-142  TO M-MSG-24I
               END-IF
           END-IF.

           EJECT
       G040-DEL-MODE-OLD.

           MOVE 'G040'      TO CA-PARAGRAPH-NBR.

           IF  OLD-FCST-ID
               PERFORM B600-SECURITY-CHECK
               IF  SECURITY-OK
                   CONTINUE
               ELSE
                   SET ERRORS          TO TRUE
                   MOVE  -1            TO M-DPT-CL
                   MOVE W9999-MSG-069  TO M-MSG-24I
               END-IF
               IF  NO-ERRORS
                   PERFORM G100-DO-DELETE
               END-IF
           ELSE
               PERFORM A250-RE-INIT-OUTPUT-VALUES
           END-IF.

           EJECT
       G100-DO-DELETE.

           MOVE 'G100'      TO CA-PARAGRAPH-NBR.

           MOVE W0001-FCST-ID   TO F-FCSID-N   IN DCLTFFCSHDR.
           MOVE CA-OP-RGN       TO F-MKTCRGN-C IN DCLTFPRODLN.

           EXEC SQL
             DELETE FROM D108.TFFCSHDR
              WHERE F_FCSID_N   = :DCLTFFCSHDR.F-FCSID-N
                AND F_MKTCRGN_C = :DCLTFPRODLN.F-MKTCRGN-C
           END-EXEC.

           SET NORMAL-RC-ONLY  TO TRUE.
           PERFORM Z900-DB2-CHECK.

           IF  DB2-NORMAL
               MOVE -1             TO M-FCSID-NL
               MOVE W9999-MSG-044  TO M-MSG-24I
               MOVE ZERO           TO CA-CURR-FCST-ID
               SET BAD-FCST-ID     TO TRUE
               PERFORM G120-PROCESS-DELETE-AUDIT
               IF  TFPRJHDR-OK
               AND CA-SYSTEM-ADMINISTRATOR
                   EXEC SQL
                        DELETE FROM D108.TFPRJHDR
                         WHERE F_FCSID_N   = :DCLTFFCSHDR.F-FCSID-N
                           AND F_MKTCRGN_C = :DCLTFPRODLN.F-MKTCRGN-C
                   END-EXEC
                   PERFORM Z900-DB2-CHECK

                   MOVE M-F-PRJ-NI      TO F-PRJ-N     IN DCLTFPRJHDR
                   MOVE M-DPT-CI        TO F-DPT-C     IN DCLTFPRJHDR
                   MOVE M-SUBDPT-CI     TO F-SUBDPT-C  IN DCLTFPRJHDR

                   EXEC SQL
                        DELETE FROM D108.TFPRJACT
                         WHERE F_MKTCRGN_C = :DCLTFPRODLN.F-MKTCRGN-C
                           AND F_PRJ_N     = :DCLTFPRJHDR.F-PRJ-N
                           AND F_DPT_C     = :DCLTFPRJHDR.F-DPT-C
                           AND F_SUBDPT_C  = :DCLTFPRJHDR.F-SUBDPT-C
                   END-EXEC
                   PERFORM Z900-DB2-CHECK
               END-IF
           END-IF.

           EJECT
       G120-PROCESS-DELETE-AUDIT.

           MOVE 'G120'      TO CA-PARAGRAPH-NBR.

           MOVE 'TFFCSHDR'  TO DB-TBLNAME-X      IN DCLTFAUDIT.
           MOVE CA-OP-ID    TO A-UID-C           IN DCLTFAUDIT.
           MOVE 'D'         TO DB-ACTN-C         IN DCLTFAUDIT.
           MOVE 'B'         TO DB-DATAIMG-C      IN DCLTFAUDIT.
           MOVE CA-DCLTFFCSHDR-SAVE
             TO DB-DATAIMG-X-TEXT IN DCLTFAUDIT.
           MOVE LENGTH OF DCLTFFCSHDR
             TO DB-DATAIMG-X-LEN  IN DCLTFAUDIT.

           PERFORM E150-INSERT-TFAUDIT.

           EJECT
       H100-PROCESS-PF9-KEY.

           MOVE 'H100'      TO CA-PARAGRAPH-NBR.

      *     FIND VALID EIBCSPOS TO DETERMINE PRODLN OR EXPTYP HELP

           MOVE EIBCPOSN  TO  W0001-CURSOR-POS
           MOVE EIBCPOSN  TO  CA-EIBCPOSN
           COMPUTE W0001-LINE-NO
           = (W0001-CURSOR-POS / W0001-LINE-VALUE ).

           EVALUATE TRUE
               WHEN W0001-LINE-NO = W0001-PRODLN-LINE
                    SET HELP-PRODLN  TO TRUE
               WHEN W0001-LINE-NO = W0001-EXPTYP-LINE
                    SET HELP-EXPTYP  TO TRUE
               WHEN W0001-LINE-NO = W0001-EXPSUBTYP-LINE
                    SET HELP-EXPTYP  TO TRUE
               WHEN OTHER
                    SET ERRORS          TO TRUE
                    SET HELP-ERRORS     TO TRUE
                    MOVE  W9999-MSG-116 TO M-MSG-24I
           END-EVALUATE.

           IF  NO-ERRORS
               IF  CA-UPDATE
                   IF  M-F-PRJ-NI = SPACES
                       CONTINUE
                   ELSE
                       SET ERRORS          TO TRUE
                       SET HELP-ERRORS     TO TRUE
                       MOVE W9999-MSG-143  TO M-MSG-24I
                   END-IF
               END-IF
           END-IF.

           IF  NO-ERRORS
               PERFORM A210-SAVE-MAP
               MOVE HELP-SCREEN-TXN-ID  TO W0001-TXN-ID
               PERFORM Y700-START-TRANSACTION
           END-IF.

           EJECT
       N000-OUTPUT-MAP-AMOUNTS.
           MOVE 'N000'      TO CA-PARAGRAPH-NBR.


           EJECT
      **======================================================**
      **  NU   IC CONVERSION ROUTINE                          **
      **======================================================**
           COPY C751CONV.

           EJECT
      **======================================================**
      **  COPYBOOK AREA FOR CICS CONTROL AND SUB-MODULES      **
      **======================================================**
           EJECT
           EXEC SQL
              INCLUDE C108Z000
           END-EXEC.

           EJECT
           COPY C108Z900.

           EJECT
           COPY C108Z998.

